calc-aent.el 41 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274
  1. ;;; calc-aent.el --- algebraic entry functions for Calc
  2. ;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
  3. ;; Author: Dave Gillespie <daveg@synaptics.com>
  4. ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
  5. ;; This file is part of GNU Emacs.
  6. ;; GNU Emacs is free software: you can redistribute it and/or modify
  7. ;; it under the terms of the GNU General Public License as published by
  8. ;; the Free Software Foundation, either version 3 of the License, or
  9. ;; (at your option) any later version.
  10. ;; GNU Emacs is distributed in the hope that it will be useful,
  11. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. ;; GNU General Public License for more details.
  14. ;; You should have received a copy of the GNU General Public License
  15. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  16. ;;; Commentary:
  17. ;;; Code:
  18. ;; This file is autoloaded from calc.el.
  19. (require 'calc)
  20. (require 'calc-macs)
  21. ;; Declare functions which are defined elsewhere.
  22. (declare-function calc-refresh-evaltos "calc-ext" (&optional which-var))
  23. (declare-function calc-execute-kbd-macro "calc-prog" (mac arg &rest prefix))
  24. (declare-function math-is-true "calc-ext" (expr))
  25. (declare-function calc-explain-why "calc-stuff" (why &optional more))
  26. (declare-function calc-alg-edit "calc-yank" (str))
  27. (declare-function math-composite-inequalities "calc-prog" (x op))
  28. (declare-function math-flatten-lands "calc-rewr" (expr))
  29. (declare-function math-multi-subst "calc-map" (expr olds news))
  30. (declare-function calcFunc-vmatches "calc-rewr" (expr pat))
  31. (declare-function math-simplify "calc-alg" (top-expr))
  32. (declare-function math-known-matrixp "calc-arith" (a))
  33. (declare-function math-parse-fortran-subscr "calc-lang" (sym args))
  34. (declare-function math-to-radians-2 "calc-math" (a))
  35. (declare-function math-read-string "calc-ext" ())
  36. (declare-function math-read-brackets "calc-vec" (space-sep math-rb-close))
  37. (declare-function math-read-angle-brackets "calc-forms" ())
  38. (declare-function math-to-percentsigns "calccomp" (x))
  39. (defvar calc-quick-calc-history nil
  40. "The history list for quick-calc.")
  41. ;;;###autoload
  42. (defun calc-do-quick-calc ()
  43. (require 'calc-ext)
  44. (calc-check-defines)
  45. (if (eq major-mode 'calc-mode)
  46. (calc-algebraic-entry t)
  47. (let (buf shortbuf)
  48. (save-excursion
  49. (calc-create-buffer)
  50. (let* ((calc-command-flags nil)
  51. (calc-dollar-values calc-quick-prev-results)
  52. (calc-dollar-used 0)
  53. (enable-recursive-minibuffers t)
  54. (calc-language (if (memq calc-language '(nil big))
  55. 'flat calc-language))
  56. (entry (calc-do-alg-entry "" "Quick calc: " t 'calc-quick-calc-history))
  57. (alg-exp (mapcar 'math-evaluate-expr entry)))
  58. (when (and (= (length alg-exp) 1)
  59. (eq (car-safe (car alg-exp)) 'calcFunc-assign)
  60. (= (length (car alg-exp)) 3)
  61. (eq (car-safe (nth 1 (car alg-exp))) 'var))
  62. (set (nth 2 (nth 1 (car alg-exp))) (nth 2 (car alg-exp)))
  63. (calc-refresh-evaltos (nth 2 (nth 1 (car alg-exp))))
  64. (setq alg-exp (list (nth 2 (car alg-exp)))))
  65. (setq calc-quick-prev-results alg-exp
  66. buf (mapconcat (function (lambda (x)
  67. (math-format-value x 1000)))
  68. alg-exp
  69. " ")
  70. shortbuf buf)
  71. (if (and (= (length alg-exp) 1)
  72. (memq (car-safe (car alg-exp)) '(nil bigpos bigneg))
  73. (< (length buf) 20)
  74. (= calc-number-radix 10))
  75. (setq buf (concat buf " ("
  76. (let ((calc-number-radix 16))
  77. (math-format-value (car alg-exp) 1000))
  78. ", "
  79. (let ((calc-number-radix 8))
  80. (math-format-value (car alg-exp) 1000))
  81. ", "
  82. (let ((calc-number-radix 2))
  83. (math-format-value (car alg-exp) 1000))
  84. (if (and (integerp (car alg-exp))
  85. (> (car alg-exp) 0)
  86. (< (car alg-exp) 127))
  87. (format ", \"%c\"" (car alg-exp))
  88. "")
  89. ")")))
  90. (if (and (< (length buf) (frame-width)) (= (length entry) 1)
  91. (featurep 'calc-ext))
  92. (let ((long (concat (math-format-value (car entry) 1000)
  93. " => " buf)))
  94. (if (<= (length long) (- (frame-width) 8))
  95. (setq buf long))))
  96. (calc-handle-whys)
  97. (message "Result: %s" buf)))
  98. (if (eq last-command-event 10)
  99. (insert shortbuf)
  100. (kill-new shortbuf)))))
  101. ;;;###autoload
  102. (defun calc-do-calc-eval (str separator args)
  103. (calc-check-defines)
  104. (catch 'calc-error
  105. (save-excursion
  106. (calc-create-buffer)
  107. (cond
  108. ((and (consp str) (not (symbolp (car str))))
  109. (let ((calc-language nil)
  110. (math-expr-opers (math-standard-ops))
  111. (calc-internal-prec 12)
  112. (calc-word-size 32)
  113. (calc-symbolic-mode nil)
  114. (calc-matrix-mode nil)
  115. (calc-angle-mode 'deg)
  116. (calc-number-radix 10)
  117. (calc-twos-complement-mode nil)
  118. (calc-leading-zeros nil)
  119. (calc-group-digits nil)
  120. (calc-point-char ".")
  121. (calc-frac-format '(":" nil))
  122. (calc-prefer-frac nil)
  123. (calc-hms-format "%s@ %s' %s\"")
  124. (calc-date-format '((H ":" mm C SS pp " ")
  125. Www " " Mmm " " D ", " YYYY))
  126. (calc-float-format '(float 0))
  127. (calc-full-float-format '(float 0))
  128. (calc-complex-format nil)
  129. (calc-matrix-just nil)
  130. (calc-full-vectors t)
  131. (calc-break-vectors nil)
  132. (calc-vector-commas ",")
  133. (calc-vector-brackets "[]")
  134. (calc-matrix-brackets '(R O))
  135. (calc-complex-mode 'cplx)
  136. (calc-infinite-mode nil)
  137. (calc-display-strings nil)
  138. (calc-simplify-mode nil)
  139. (calc-display-working-message 'lots)
  140. (strp (cdr str)))
  141. (while strp
  142. (set (car strp) (nth 1 strp))
  143. (setq strp (cdr (cdr strp))))
  144. (calc-do-calc-eval (car str) separator args)))
  145. ((eq separator 'eval)
  146. (eval str))
  147. ((eq separator 'macro)
  148. (require 'calc-ext)
  149. (let* ((calc-buffer (current-buffer))
  150. (calc-window (get-buffer-window calc-buffer))
  151. (save-window (selected-window)))
  152. (if calc-window
  153. (unwind-protect
  154. (progn
  155. (select-window calc-window)
  156. (calc-execute-kbd-macro str nil (car args)))
  157. (and (window-point save-window)
  158. (select-window save-window)))
  159. (save-window-excursion
  160. (select-window (get-largest-window))
  161. (switch-to-buffer calc-buffer)
  162. (calc-execute-kbd-macro str nil (car args)))))
  163. nil)
  164. ((eq separator 'pop)
  165. (or (not (integerp str))
  166. (= str 0)
  167. (calc-pop (min str (calc-stack-size))))
  168. (calc-stack-size))
  169. ((eq separator 'top)
  170. (and (integerp str)
  171. (> str 0)
  172. (<= str (calc-stack-size))
  173. (math-format-value (calc-top-n str (car args)) 1000)))
  174. ((eq separator 'rawtop)
  175. (and (integerp str)
  176. (> str 0)
  177. (<= str (calc-stack-size))
  178. (calc-top-n str (car args))))
  179. (t
  180. (let* ((calc-command-flags nil)
  181. (calc-next-why nil)
  182. (calc-language (if (memq calc-language '(nil big))
  183. 'flat calc-language))
  184. (calc-dollar-values (mapcar
  185. (function
  186. (lambda (x)
  187. (if (stringp x)
  188. (progn
  189. (setq x (math-read-exprs x))
  190. (if (eq (car-safe x)
  191. 'error)
  192. (throw 'calc-error
  193. (calc-eval-error
  194. (cdr x)))
  195. (car x)))
  196. x)))
  197. args))
  198. (calc-dollar-used 0)
  199. (res (if (stringp str)
  200. (math-read-exprs str)
  201. (list str)))
  202. buf)
  203. (if (eq (car res) 'error)
  204. (calc-eval-error (cdr res))
  205. (setq res (mapcar 'calc-normalize res))
  206. (and (memq 'clear-message calc-command-flags)
  207. (message ""))
  208. (cond ((eq separator 'pred)
  209. (require 'calc-ext)
  210. (if (= (length res) 1)
  211. (math-is-true (car res))
  212. (calc-eval-error '(0 "Single value expected"))))
  213. ((eq separator 'raw)
  214. (if (= (length res) 1)
  215. (car res)
  216. (calc-eval-error '(0 "Single value expected"))))
  217. ((eq separator 'list)
  218. res)
  219. ((memq separator '(num rawnum))
  220. (if (= (length res) 1)
  221. (if (math-constp (car res))
  222. (if (eq separator 'num)
  223. (math-format-value (car res) 1000)
  224. (car res))
  225. (calc-eval-error
  226. (list 0
  227. (if calc-next-why
  228. (calc-explain-why (car calc-next-why))
  229. "Number expected"))))
  230. (calc-eval-error '(0 "Single value expected"))))
  231. ((eq separator 'push)
  232. (calc-push-list res)
  233. nil)
  234. (t (while res
  235. (setq buf (concat buf
  236. (and buf (or separator ", "))
  237. (math-format-value (car res) 1000))
  238. res (cdr res)))
  239. buf)))))))))
  240. (defvar calc-eval-error nil
  241. "Determines how calc handles errors.
  242. If nil, return a list containing the character position of error.
  243. STRING means return error message as string rather than list.
  244. The value t means abort and give an error message.")
  245. (defun calc-eval-error (msg)
  246. (if calc-eval-error
  247. (if (eq calc-eval-error 'string)
  248. (nth 1 msg)
  249. (error "%s" (nth 1 msg)))
  250. msg))
  251. ;;;; Reading an expression in algebraic form.
  252. ;;;###autoload
  253. (defun calc-auto-algebraic-entry (&optional prefix)
  254. (interactive "P")
  255. (calc-algebraic-entry prefix t))
  256. ;;;###autoload
  257. (defun calc-algebraic-entry (&optional prefix auto)
  258. (interactive "P")
  259. (calc-wrapper
  260. (let ((calc-language (if prefix nil calc-language))
  261. (math-expr-opers (if prefix (math-standard-ops) (math-expr-ops))))
  262. (calc-alg-entry (and auto (char-to-string last-command-event))))))
  263. (defvar calc-alg-entry-history nil
  264. "History for algebraic entry.")
  265. ;;;###autoload
  266. (defun calc-alg-entry (&optional initial prompt)
  267. (let* ((sel-mode nil)
  268. (calc-dollar-values (mapcar 'calc-get-stack-element
  269. (nthcdr calc-stack-top calc-stack)))
  270. (calc-dollar-used 0)
  271. (calc-plain-entry t)
  272. (alg-exp (calc-do-alg-entry initial prompt t 'calc-alg-entry-history)))
  273. (if (stringp alg-exp)
  274. (progn
  275. (require 'calc-ext)
  276. (calc-alg-edit alg-exp))
  277. (let* ((calc-simplify-mode (if (eq last-command-event ?\C-j)
  278. 'none
  279. calc-simplify-mode))
  280. (nvals (mapcar 'calc-normalize alg-exp)))
  281. (while alg-exp
  282. (calc-record (if (featurep 'calc-ext) (car alg-exp) (car nvals))
  283. "alg'")
  284. (calc-pop-push-record-list calc-dollar-used
  285. (and (not (equal (car alg-exp)
  286. (car nvals)))
  287. (featurep 'calc-ext)
  288. "")
  289. (list (car nvals)))
  290. (setq alg-exp (cdr alg-exp)
  291. nvals (cdr nvals)
  292. calc-dollar-used 0)))
  293. (calc-handle-whys))))
  294. (defvar calc-alg-ent-map
  295. (let ((map (make-sparse-keymap)))
  296. (set-keymap-parent map minibuffer-local-map)
  297. (define-key map "'" 'calcAlg-previous)
  298. (define-key map "`" 'calcAlg-edit)
  299. (define-key map "\C-m" 'calcAlg-enter)
  300. (define-key map "\C-j" 'calcAlg-enter)
  301. map)
  302. "The keymap used for algebraic entry.")
  303. (defvar calc-alg-ent-esc-map
  304. (let ((map (make-keymap))
  305. (i 33))
  306. (set-keymap-parent map esc-map)
  307. (while (< i 127)
  308. (define-key map (vector i) 'calcAlg-escape)
  309. (setq i (1+ i)))
  310. map)
  311. "The keymap used for escapes in algebraic entry.")
  312. (defvar calc-alg-exp)
  313. ;;;###autoload
  314. (defun calc-do-alg-entry (&optional initial prompt no-normalize history)
  315. (let* ((calc-buffer (current-buffer))
  316. (blink-matching-check-function 'calcAlg-blink-matching-check)
  317. (calc-alg-exp 'error))
  318. (define-key calc-alg-ent-map "\e" nil)
  319. (if (eq calc-algebraic-mode 'total)
  320. (define-key calc-alg-ent-map "\e" calc-alg-ent-esc-map)
  321. (define-key calc-alg-ent-map "\e+" 'calcAlg-plus-minus)
  322. (define-key calc-alg-ent-map "\em" 'calcAlg-mod)
  323. (define-key calc-alg-ent-map "\e=" 'calcAlg-equals)
  324. (define-key calc-alg-ent-map "\e\r" 'calcAlg-equals)
  325. (define-key calc-alg-ent-map "\ep" 'previous-history-element)
  326. (define-key calc-alg-ent-map "\en" 'next-history-element)
  327. (define-key calc-alg-ent-map "\e%" 'self-insert-command))
  328. (setq calc-aborted-prefix nil)
  329. (let ((buf (read-from-minibuffer (or prompt "Algebraic: ")
  330. (or initial "")
  331. calc-alg-ent-map nil history)))
  332. (when (eq calc-alg-exp 'error)
  333. (when (eq (car-safe (setq calc-alg-exp (math-read-exprs buf))) 'error)
  334. (setq calc-alg-exp nil)))
  335. (setq calc-aborted-prefix "alg'")
  336. (or no-normalize
  337. (and calc-alg-exp (setq calc-alg-exp (mapcar 'calc-normalize calc-alg-exp))))
  338. calc-alg-exp)))
  339. (defun calcAlg-plus-minus ()
  340. (interactive)
  341. (if (calc-minibuffer-contains ".* \\'")
  342. (insert "+/- ")
  343. (insert " +/- ")))
  344. (defun calcAlg-mod ()
  345. (interactive)
  346. (if (not (calc-minibuffer-contains ".* \\'"))
  347. (insert " "))
  348. (if (calc-minibuffer-contains ".* mod +\\'")
  349. (if calc-previous-modulo
  350. (insert (math-format-flat-expr calc-previous-modulo 0))
  351. (beep))
  352. (insert "mod ")))
  353. (defun calcAlg-previous ()
  354. (interactive)
  355. (if (calc-minibuffer-contains "\\'")
  356. (previous-history-element 1)
  357. (insert "'")))
  358. (defun calcAlg-equals ()
  359. (interactive)
  360. (unwind-protect
  361. (calcAlg-enter)
  362. (if (consp calc-alg-exp)
  363. (progn (setq prefix-arg (length calc-alg-exp))
  364. (calc-unread-command ?=)))))
  365. (defun calcAlg-escape ()
  366. (interactive)
  367. (calc-unread-command)
  368. (save-excursion
  369. (calc-select-buffer)
  370. (use-local-map calc-mode-map))
  371. (calcAlg-enter))
  372. (defvar calc-plain-entry nil)
  373. (defun calcAlg-edit ()
  374. (interactive)
  375. (if (or (not calc-plain-entry)
  376. (calc-minibuffer-contains
  377. "\\`\\([^\"]*\"[^\"]*\"\\)*[^\"]*\"[^\"]*\\'"))
  378. (insert "`")
  379. (setq calc-alg-exp (minibuffer-contents))
  380. (exit-minibuffer)))
  381. (defvar calc-buffer)
  382. (defun calcAlg-enter ()
  383. (interactive)
  384. (let* ((str (minibuffer-contents))
  385. (exp (and (> (length str) 0)
  386. (with-current-buffer calc-buffer
  387. (math-read-exprs str)))))
  388. (if (eq (car-safe exp) 'error)
  389. (progn
  390. (goto-char (minibuffer-prompt-end))
  391. (forward-char (nth 1 exp))
  392. (beep)
  393. (calc-temp-minibuffer-message
  394. (concat " [" (or (nth 2 exp) "Error") "]"))
  395. (calc-clear-unread-commands))
  396. (setq calc-alg-exp (if (calc-minibuffer-contains "\\` *\\[ *\\'")
  397. '((incomplete vec))
  398. exp))
  399. (exit-minibuffer))))
  400. (defun calcAlg-blink-matching-check (leftpt rightpt)
  401. (let ((rightchar (char-before rightpt))
  402. (leftchar (if leftpt (char-after leftpt))))
  403. (if (and leftpt
  404. (or (and (= rightchar ?\))
  405. (= leftchar ?\[))
  406. (and (= rightchar ?\])
  407. (= leftchar ?\()))
  408. (save-excursion
  409. (goto-char leftpt)
  410. (looking-at ".+\\(\\.\\.\\|\\\\dots\\|\\\\ldots\\)")))
  411. ;; [2..5) perfectly valid!
  412. nil
  413. (blink-matching-check-mismatch leftpt rightpt))))
  414. ;;;###autoload
  415. (defun calc-alg-digit-entry ()
  416. (calc-alg-entry
  417. (cond ((eq last-command-event ?e)
  418. (if (> calc-number-radix 14) (format "%d.^" calc-number-radix) "1e"))
  419. ((eq last-command-event ?#) (format "%d#" calc-number-radix))
  420. ((eq last-command-event ?_) "-")
  421. ((eq last-command-event ?@) "0@ ")
  422. (t (char-to-string last-command-event)))))
  423. ;; The variable calc-digit-value is initially declared in calc.el,
  424. ;; but can be set by calcDigit-algebraic and calcDigit-edit.
  425. (defvar calc-digit-value)
  426. ;;;###autoload
  427. (defun calcDigit-algebraic ()
  428. (interactive)
  429. (if (calc-minibuffer-contains ".*[@oh] *[^'m ]+[^'m]*\\'")
  430. (calcDigit-key)
  431. (setq calc-digit-value (minibuffer-contents))
  432. (exit-minibuffer)))
  433. ;;;###autoload
  434. (defun calcDigit-edit ()
  435. (interactive)
  436. (calc-unread-command)
  437. (setq calc-digit-value (minibuffer-contents))
  438. (exit-minibuffer))
  439. ;;; Algebraic expression parsing. [Public]
  440. (defvar math-read-replacement-list
  441. '(;; Misc symbols
  442. ("±" "+/-") ; plus or minus
  443. ("×" "*") ; multiplication sign
  444. ("÷" ":") ; division sign
  445. ("−" "-") ; subtraction sign
  446. ("∕" "/") ; division sign
  447. ("∗" "*") ; asterisk multiplication
  448. ("∞" "inf") ; infinity symbol
  449. ("≤" "<=")
  450. ("≥" ">=")
  451. ("≦" "<=")
  452. ("≧" ">=")
  453. ("µ" "μ")
  454. ;; fractions
  455. ("¼" "(1:4)") ; 1/4
  456. ("½" "(1:2)") ; 1/2
  457. ("¾" "(3:4)") ; 3/4
  458. ("⅓" "(1:3)") ; 1/3
  459. ("⅔" "(2:3)") ; 2/3
  460. ("⅕" "(1:5)") ; 1/5
  461. ("⅖" "(2:5)") ; 2/5
  462. ("⅗" "(3:5)") ; 3/5
  463. ("⅘" "(4:5)") ; 4/5
  464. ("⅙" "(1:6)") ; 1/6
  465. ("⅚" "(5:6)") ; 5/6
  466. ("⅛" "(1:8)") ; 1/8
  467. ("⅜" "(3:8)") ; 3/8
  468. ("⅝" "(5:8)") ; 5/8
  469. ("⅞" "(7:8)") ; 7/8
  470. ("⅟" "1:") ; 1/...
  471. ;; superscripts
  472. ("⁰" "0") ; 0
  473. ("¹" "1") ; 1
  474. ("²" "2") ; 2
  475. ("³" "3") ; 3
  476. ("⁴" "4") ; 4
  477. ("⁵" "5") ; 5
  478. ("⁶" "6") ; 6
  479. ("⁷" "7") ; 7
  480. ("⁸" "8") ; 8
  481. ("⁹" "9") ; 9
  482. ("⁺" "+") ; +
  483. ("⁻" "-") ; -
  484. ("⁽" "(") ; (
  485. ("⁾" ")") ; )
  486. ("ⁿ" "n") ; n
  487. ("ⁱ" "i") ; i
  488. ;; subscripts
  489. ("₀" "0") ; 0
  490. ("₁" "1") ; 1
  491. ("₂" "2") ; 2
  492. ("₃" "3") ; 3
  493. ("₄" "4") ; 4
  494. ("₅" "5") ; 5
  495. ("₆" "6") ; 6
  496. ("₇" "7") ; 7
  497. ("₈" "8") ; 8
  498. ("₉" "9") ; 9
  499. ("₊" "+") ; +
  500. ("₋" "-") ; -
  501. ("₍" "(") ; (
  502. ("₎" ")")) ; )
  503. "A list whose elements (old new) indicate replacements to make
  504. in Calc algebraic input.")
  505. (defvar math-read-superscripts
  506. "⁰¹²³⁴⁵⁶⁷⁸⁹⁺⁻⁽⁾ⁿⁱ" ; 0123456789+-()ni
  507. "A string consisting of the superscripts allowed by Calc.")
  508. (defvar math-read-subscripts
  509. "₀₁₂₃₄₅₆₇₈₉₊₋₍₎" ; 0123456789+-()
  510. "A string consisting of the subscripts allowed by Calc.")
  511. ;;;###autoload
  512. (defun math-read-preprocess-string (str)
  513. "Replace some substrings of STR by Calc equivalents."
  514. (setq str
  515. (replace-regexp-in-string (concat "[" math-read-superscripts "]+")
  516. "^(\\&)" str))
  517. (setq str
  518. (replace-regexp-in-string (concat "[" math-read-subscripts "]+")
  519. "_(\\&)" str))
  520. (let ((rep-list math-read-replacement-list))
  521. (while rep-list
  522. (setq str
  523. (replace-regexp-in-string (nth 0 (car rep-list))
  524. (nth 1 (car rep-list)) str))
  525. (setq rep-list (cdr rep-list))))
  526. str)
  527. ;; The next few variables are local to math-read-exprs (and math-read-expr
  528. ;; in calc-ext.el), but are set in functions they call.
  529. (defvar math-exp-pos)
  530. (defvar math-exp-str)
  531. (defvar math-exp-old-pos)
  532. (defvar math-exp-token)
  533. (defvar math-exp-keep-spaces)
  534. (defvar math-expr-data)
  535. ;;;###autoload
  536. (defun math-read-exprs (math-exp-str)
  537. (let ((math-exp-pos 0)
  538. (math-exp-old-pos 0)
  539. (math-exp-keep-spaces nil)
  540. math-exp-token math-expr-data)
  541. (setq math-exp-str (math-read-preprocess-string math-exp-str))
  542. (if (memq calc-language calc-lang-allow-percentsigns)
  543. (setq math-exp-str (math-remove-percentsigns math-exp-str)))
  544. (if calc-language-input-filter
  545. (setq math-exp-str (funcall calc-language-input-filter math-exp-str)))
  546. (while (setq math-exp-token
  547. (string-match "\\.\\.\\([^.]\\|.[^.]\\)" math-exp-str))
  548. (setq math-exp-str
  549. (concat (substring math-exp-str 0 math-exp-token) "\\dots"
  550. (substring math-exp-str (+ math-exp-token 2)))))
  551. (math-build-parse-table)
  552. (math-read-token)
  553. (let ((val (catch 'syntax (math-read-expr-list))))
  554. (if (stringp val)
  555. (list 'error math-exp-old-pos val)
  556. (if (equal math-exp-token 'end)
  557. val
  558. (list 'error math-exp-old-pos "Syntax error"))))))
  559. ;;;###autoload
  560. (defun math-read-expr-list ()
  561. (let* ((math-exp-keep-spaces nil)
  562. (val (list (math-read-expr-level 0)))
  563. (last val))
  564. (while (equal math-expr-data ",")
  565. (math-read-token)
  566. (let ((rest (list (math-read-expr-level 0))))
  567. (setcdr last rest)
  568. (setq last rest)))
  569. val))
  570. (defvar calc-user-parse-table nil)
  571. (defvar calc-last-main-parse-table nil)
  572. (defvar calc-last-user-lang-parse-table nil)
  573. (defvar calc-last-lang-parse-table nil)
  574. (defvar calc-user-tokens nil)
  575. (defvar calc-user-token-chars nil)
  576. (defvar math-toks nil
  577. "Tokens to pass between math-build-parse-table and math-find-user-tokens.")
  578. ;;;###autoload
  579. (defun math-build-parse-table ()
  580. (let ((mtab (cdr (assq nil calc-user-parse-tables)))
  581. (ltab (cdr (assq calc-language calc-user-parse-tables)))
  582. (lltab (get calc-language 'math-parse-table)))
  583. (or (and (eq mtab calc-last-main-parse-table)
  584. (eq ltab calc-last-user-lang-parse-table)
  585. (eq lltab calc-last-lang-parse-table))
  586. (let ((p (append mtab ltab lltab))
  587. (math-toks nil))
  588. (setq calc-user-parse-table p)
  589. (setq calc-user-token-chars nil)
  590. (while p
  591. (math-find-user-tokens (car (car p)))
  592. (setq p (cdr p)))
  593. (setq calc-user-tokens (mapconcat 'identity
  594. (sort (mapcar 'car math-toks)
  595. (function (lambda (x y)
  596. (> (length x)
  597. (length y)))))
  598. "\\|")
  599. calc-last-main-parse-table mtab
  600. calc-last-user-lang-parse-table ltab
  601. calc-last-lang-parse-table lltab)))))
  602. ;;;###autoload
  603. (defun math-find-user-tokens (p)
  604. (while p
  605. (cond ((and (stringp (car p))
  606. (or (> (length (car p)) 1) (equal (car p) "$")
  607. (equal (car p) "\""))
  608. (string-match "[^a-zA-Zα-ωΑ-Ω0-9]" (car p)))
  609. (let ((s (regexp-quote (car p))))
  610. (if (string-match "\\`[a-zA-Zα-ωΑ-Ω0-9]" s)
  611. (setq s (concat "\\<" s)))
  612. (if (string-match "[a-zA-Zα-ωΑ-Ω0-9]\\'" s)
  613. (setq s (concat s "\\>")))
  614. (or (assoc s math-toks)
  615. (progn
  616. (setq math-toks (cons (list s) math-toks))
  617. (or (memq (aref (car p) 0) calc-user-token-chars)
  618. (setq calc-user-token-chars
  619. (cons (aref (car p) 0)
  620. calc-user-token-chars)))))))
  621. ((consp (car p))
  622. (math-find-user-tokens (nth 1 (car p)))
  623. (or (eq (car (car p)) '\?)
  624. (math-find-user-tokens (nth 2 (car p))))))
  625. (setq p (cdr p))))
  626. ;;;###autoload
  627. (defun math-read-token ()
  628. (if (>= math-exp-pos (length math-exp-str))
  629. (setq math-exp-old-pos math-exp-pos
  630. math-exp-token 'end
  631. math-expr-data "\000")
  632. (let (adfn
  633. (ch (aref math-exp-str math-exp-pos)))
  634. (setq math-exp-old-pos math-exp-pos)
  635. (cond ((memq ch '(32 10 9))
  636. (setq math-exp-pos (1+ math-exp-pos))
  637. (if math-exp-keep-spaces
  638. (setq math-exp-token 'space
  639. math-expr-data " ")
  640. (math-read-token)))
  641. ((and (memq ch calc-user-token-chars)
  642. (let ((case-fold-search nil))
  643. (eq (string-match
  644. calc-user-tokens math-exp-str math-exp-pos)
  645. math-exp-pos)))
  646. (setq math-exp-token 'punc
  647. math-expr-data (math-match-substring math-exp-str 0)
  648. math-exp-pos (match-end 0)))
  649. ((or (and (>= ch ?a) (<= ch ?z))
  650. (and (>= ch ?A) (<= ch ?Z))
  651. (and (>= ch ?α) (<= ch ?ω))
  652. (and (>= ch ?Α) (<= ch ?Ω)))
  653. (string-match
  654. (cond
  655. ((and (memq calc-language calc-lang-allow-underscores)
  656. (memq calc-language calc-lang-allow-percentsigns))
  657. "[a-zA-Zα-ωΑ-Ω0-9_'#]*")
  658. ((memq calc-language calc-lang-allow-underscores)
  659. "[a-zA-Zα-ωΑ-Ω0-9_#]*")
  660. (t "[a-zA-Zα-ωΑ-Ω0-9'#]*"))
  661. math-exp-str math-exp-pos)
  662. (setq math-exp-token 'symbol
  663. math-exp-pos (match-end 0)
  664. math-expr-data (math-restore-dashes
  665. (math-match-substring math-exp-str 0)))
  666. (if (setq adfn (get calc-language 'math-lang-adjust-words))
  667. (funcall adfn)))
  668. ((or (and (>= ch ?0) (<= ch ?9))
  669. (and (eq ch '?\.)
  670. (eq (string-match "\\.[0-9]" math-exp-str math-exp-pos)
  671. math-exp-pos))
  672. (and (eq ch '?_)
  673. (eq (string-match "_\\.?[0-9]" math-exp-str math-exp-pos)
  674. math-exp-pos)
  675. (or (eq math-exp-pos 0)
  676. (and (not (memq calc-language
  677. calc-lang-allow-underscores))
  678. (eq (string-match "[^])}\"a-zA-Zα-ωΑ-Ω0-9'$]_"
  679. math-exp-str (1- math-exp-pos))
  680. (1- math-exp-pos))))))
  681. (or (and (memq calc-language calc-lang-c-type-hex)
  682. (string-match "0[xX][0-9a-fA-F]+" math-exp-str math-exp-pos))
  683. (string-match "_?\\([0-9]+.?0*@ *\\)?\\([0-9]+.?0*' *\\)?\\(0*\\([2-9]\\|1[0-4]\\)\\(#[#]?\\|\\^\\^\\)[0-9a-dA-D.]+[eE][-+_]?[0-9]+\\|0*\\([2-9]\\|[0-2][0-9]\\|3[0-6]\\)\\(#[#]?\\|\\^\\^\\)[0-9a-zA-Zα-ωΑ-Ω:.]+\\|[0-9]+:[0-9:]+\\|[0-9.]+\\([eE][-+_]?[0-9]+\\)?\"?\\)?"
  684. math-exp-str math-exp-pos))
  685. (setq math-exp-token 'number
  686. math-expr-data (math-match-substring math-exp-str 0)
  687. math-exp-pos (match-end 0)))
  688. ((and (setq adfn
  689. (assq ch (get calc-language 'math-lang-read-symbol)))
  690. (eval (nth 1 adfn)))
  691. (eval (nth 2 adfn)))
  692. ((eq ch ?\$)
  693. (if (eq (string-match "\\$\\([1-9][0-9]*\\)" math-exp-str math-exp-pos)
  694. math-exp-pos)
  695. (setq math-expr-data (- (string-to-number (math-match-substring
  696. math-exp-str 1))))
  697. (string-match "\\$+" math-exp-str math-exp-pos)
  698. (setq math-expr-data (- (match-end 0) (match-beginning 0))))
  699. (setq math-exp-token 'dollar
  700. math-exp-pos (match-end 0)))
  701. ((eq ch ?\#)
  702. (if (eq (string-match "#\\([1-9][0-9]*\\)" math-exp-str math-exp-pos)
  703. math-exp-pos)
  704. (setq math-expr-data (string-to-number
  705. (math-match-substring math-exp-str 1))
  706. math-exp-pos (match-end 0))
  707. (setq math-expr-data 1
  708. math-exp-pos (1+ math-exp-pos)))
  709. (setq math-exp-token 'hash))
  710. ((eq (string-match "~=\\|<=\\|>=\\|<>\\|/=\\|\\+/-\\|\\\\dots\\|\\\\ldots\\|\\*\\*\\|<<\\|>>\\|==\\|!=\\|&&&\\||||\\|!!!\\|&&\\|||\\|!!\\|:=\\|::\\|=>"
  711. math-exp-str math-exp-pos)
  712. math-exp-pos)
  713. (setq math-exp-token 'punc
  714. math-expr-data (math-match-substring math-exp-str 0)
  715. math-exp-pos (match-end 0)))
  716. ((and (eq ch ?\")
  717. (string-match "\\(\"\\([^\"\\]\\|\\\\.\\)*\\)\\(\"\\|\\'\\)"
  718. math-exp-str math-exp-pos))
  719. (setq math-exp-token 'string
  720. math-expr-data (math-match-substring math-exp-str 1)
  721. math-exp-pos (match-end 0)))
  722. ((and (setq adfn (get calc-language 'math-lang-read))
  723. (eval (nth 0 adfn))
  724. (eval (nth 1 adfn))))
  725. ((eq (string-match "%%.*$" math-exp-str math-exp-pos) math-exp-pos)
  726. (setq math-exp-pos (match-end 0))
  727. (math-read-token))
  728. (t
  729. (if (setq adfn (assq ch (get calc-language 'math-punc-table)))
  730. (setq ch (cdr adfn)))
  731. (setq math-exp-token 'punc
  732. math-expr-data (char-to-string ch)
  733. math-exp-pos (1+ math-exp-pos)))))))
  734. (defconst math-alg-inequalities
  735. '(calcFunc-lt calcFunc-gt calcFunc-leq calcFunc-geq
  736. calcFunc-eq calcFunc-neq))
  737. (defun math-read-expr-level (exp-prec &optional exp-term)
  738. (let* ((math-expr-opers (math-expr-ops))
  739. (x (math-read-factor))
  740. (first t)
  741. op op2)
  742. (while (and (or (and calc-user-parse-table
  743. (setq op (calc-check-user-syntax x exp-prec))
  744. (setq x op
  745. op '("2x" ident 999999 -1)))
  746. (and (setq op (assoc math-expr-data math-expr-opers))
  747. (/= (nth 2 op) -1)
  748. (or (and (setq op2 (assoc
  749. math-expr-data
  750. (cdr (memq op math-expr-opers))))
  751. (eq (= (nth 3 op) -1)
  752. (/= (nth 3 op2) -1))
  753. (eq (= (nth 3 op2) -1)
  754. (not (math-factor-after)))
  755. (setq op op2))
  756. t))
  757. (and (or (eq (nth 2 op) -1)
  758. (memq math-exp-token '(symbol number dollar hash))
  759. (equal math-expr-data "(")
  760. (and (equal math-expr-data "[")
  761. (not (equal
  762. (get calc-language
  763. 'math-function-open) "["))
  764. (not (and math-exp-keep-spaces
  765. (eq (car-safe x) 'vec)))))
  766. (or (not (setq op (assoc math-expr-data math-expr-opers)))
  767. (/= (nth 2 op) -1))
  768. (or (not calc-user-parse-table)
  769. (not (eq math-exp-token 'symbol))
  770. (let ((p calc-user-parse-table))
  771. (while (and p
  772. (or (not (integerp
  773. (car (car (car p)))))
  774. (not (equal
  775. (nth 1 (car (car p)))
  776. math-expr-data))))
  777. (setq p (cdr p)))
  778. (not p)))
  779. (setq op (assoc "2x" math-expr-opers))))
  780. (not (and exp-term (equal math-expr-data exp-term)))
  781. (>= (nth 2 op) exp-prec))
  782. (if (not (equal (car op) "2x"))
  783. (math-read-token))
  784. (and (memq (nth 1 op) '(sdev mod))
  785. (require 'calc-ext))
  786. (setq x (cond ((consp (nth 1 op))
  787. (funcall (car (nth 1 op)) x op))
  788. ((eq (nth 3 op) -1)
  789. (if (eq (nth 1 op) 'ident)
  790. x
  791. (if (eq (nth 1 op) 'closing)
  792. (if (eq (nth 2 op) exp-prec)
  793. (progn
  794. (setq exp-prec 1000)
  795. x)
  796. (throw 'syntax "Mismatched delimiters"))
  797. (list (nth 1 op) x))))
  798. ((and (not first)
  799. (memq (nth 1 op) math-alg-inequalities)
  800. (memq (car-safe x) math-alg-inequalities))
  801. (require 'calc-ext)
  802. (math-composite-inequalities x op))
  803. (t (list (nth 1 op)
  804. x
  805. (math-read-expr-level (nth 3 op) exp-term))))
  806. first nil))
  807. x))
  808. ;; calc-arg-values is defined in calc-ext.el, but is used here.
  809. (defvar calc-arg-values)
  810. ;;;###autoload
  811. (defun calc-check-user-syntax (&optional x prec)
  812. (let ((p calc-user-parse-table)
  813. (matches nil)
  814. match rule)
  815. (while (and p
  816. (or (not (progn
  817. (setq rule (car (car p)))
  818. (if x
  819. (and (integerp (car rule))
  820. (>= (car rule) prec)
  821. (equal math-expr-data
  822. (car (setq rule (cdr rule)))))
  823. (equal math-expr-data (car rule)))))
  824. (let ((save-exp-pos math-exp-pos)
  825. (save-exp-old-pos math-exp-old-pos)
  826. (save-exp-token math-exp-token)
  827. (save-exp-data math-expr-data))
  828. (or (not (listp
  829. (setq matches (calc-match-user-syntax rule))))
  830. (let ((args (progn
  831. (require 'calc-ext)
  832. calc-arg-values))
  833. (conds nil)
  834. temp)
  835. (if x
  836. (setq matches (cons x matches)))
  837. (setq match (cdr (car p)))
  838. (while (and (eq (car-safe match)
  839. 'calcFunc-condition)
  840. (= (length match) 3))
  841. (setq conds (append (math-flatten-lands
  842. (nth 2 match))
  843. conds)
  844. match (nth 1 match)))
  845. (while (and conds match)
  846. (require 'calc-ext)
  847. (cond ((eq (car-safe (car conds))
  848. 'calcFunc-let)
  849. (setq temp (car conds))
  850. (or (= (length temp) 3)
  851. (and (= (length temp) 2)
  852. (eq (car-safe (nth 1 temp))
  853. 'calcFunc-assign)
  854. (= (length (nth 1 temp)) 3)
  855. (setq temp (nth 1 temp)))
  856. (setq match nil))
  857. (setq matches (cons
  858. (math-normalize
  859. (math-multi-subst
  860. (nth 2 temp)
  861. args matches))
  862. matches)
  863. args (cons (nth 1 temp)
  864. args)))
  865. ((and (eq (car-safe (car conds))
  866. 'calcFunc-matches)
  867. (= (length (car conds)) 3))
  868. (setq temp (calcFunc-vmatches
  869. (math-multi-subst
  870. (nth 1 (car conds))
  871. args matches)
  872. (nth 2 (car conds))))
  873. (if (eq temp 0)
  874. (setq match nil)
  875. (while (setq temp (cdr temp))
  876. (setq matches (cons (nth 2 (car temp))
  877. matches)
  878. args (cons (nth 1 (car temp))
  879. args)))))
  880. (t
  881. (or (math-is-true (math-simplify
  882. (math-multi-subst
  883. (car conds)
  884. args matches)))
  885. (setq match nil))))
  886. (setq conds (cdr conds)))
  887. (if match
  888. (not (setq match (math-multi-subst
  889. match args matches)))
  890. (setq math-exp-old-pos save-exp-old-pos
  891. math-exp-token save-exp-token
  892. math-expr-data save-exp-data
  893. math-exp-pos save-exp-pos)))))))
  894. (setq p (cdr p)))
  895. (and p match)))
  896. ;;;###autoload
  897. (defun calc-match-user-syntax (p &optional term)
  898. (let ((matches nil)
  899. (save-exp-pos math-exp-pos)
  900. (save-exp-old-pos math-exp-old-pos)
  901. (save-exp-token math-exp-token)
  902. (save-exp-data math-expr-data)
  903. m)
  904. (while (and p
  905. (cond ((stringp (car p))
  906. (and (equal math-expr-data (car p))
  907. (progn
  908. (math-read-token)
  909. t)))
  910. ((integerp (car p))
  911. (and (setq m (catch 'syntax
  912. (math-read-expr-level
  913. (car p)
  914. (if (cdr p)
  915. (if (consp (nth 1 p))
  916. (car (nth 1 (nth 1 p)))
  917. (nth 1 p))
  918. term))))
  919. (not (stringp m))
  920. (setq matches (nconc matches (list m)))))
  921. ((eq (car (car p)) '\?)
  922. (setq m (calc-match-user-syntax (nth 1 (car p))))
  923. (or (nth 2 (car p))
  924. (setq matches
  925. (nconc matches
  926. (list
  927. (cons 'vec (and (listp m) m))))))
  928. (or (listp m) (not (nth 2 (car p)))
  929. (not (eq (aref (car (nth 2 (car p))) 0) ?\$))
  930. (eq math-exp-token 'end)))
  931. (t
  932. (setq m (calc-match-user-syntax (nth 1 (car p))
  933. (car (nth 2 (car p)))))
  934. (if (listp m)
  935. (let ((vec (cons 'vec m))
  936. opos mm)
  937. (while (and (listp
  938. (setq opos math-exp-pos
  939. mm (calc-match-user-syntax
  940. (or (nth 2 (car p))
  941. (nth 1 (car p)))
  942. (car (nth 2 (car p))))))
  943. (> math-exp-pos opos))
  944. (setq vec (nconc vec mm)))
  945. (setq matches (nconc matches (list vec))))
  946. (and (eq (car (car p)) '*)
  947. (setq matches (nconc matches (list '(vec)))))))))
  948. (setq p (cdr p)))
  949. (if p
  950. (setq math-exp-pos save-exp-pos
  951. math-exp-old-pos save-exp-old-pos
  952. math-exp-token save-exp-token
  953. math-expr-data save-exp-data
  954. matches "Failed"))
  955. matches))
  956. ;;;###autoload
  957. (defun math-remove-dashes (x)
  958. (if (string-match "\\`\\(.*\\)-\\(.*\\)\\'" x)
  959. (math-remove-dashes
  960. (concat (math-match-substring x 1) "#" (math-match-substring x 2)))
  961. x))
  962. (defun math-remove-percentsigns (x)
  963. (if (string-match "\\`\\(.*\\)%\\(.*\\)\\'" x)
  964. (math-remove-percentsigns
  965. (concat (math-match-substring x 1) "o'o" (math-match-substring x 2)))
  966. x))
  967. (defun math-restore-dashes (x)
  968. (if (string-match "\\`\\(.*\\)[#_]\\(.*\\)\\'" x)
  969. (math-restore-dashes
  970. (concat (math-match-substring x 1) "-" (math-match-substring x 2)))
  971. x))
  972. (defun math-restore-placeholders (x)
  973. "Replace placeholders by the proper characters in the symbol x.
  974. This includes `#' for `_' and `'' for `%'.
  975. If the current Calc language does not use placeholders, return nil."
  976. (if (or (memq calc-language calc-lang-allow-underscores)
  977. (memq calc-language calc-lang-allow-percentsigns))
  978. (let ((sx (symbol-name x)))
  979. (when (memq calc-language calc-lang-allow-percentsigns)
  980. (require 'calccomp)
  981. (setq sx (math-to-percentsigns sx)))
  982. (if (memq calc-language calc-lang-allow-underscores)
  983. (setq sx (math-string-restore-underscores sx)))
  984. (intern-soft sx))))
  985. (defun math-string-restore-underscores (x)
  986. "Replace pound signs by underscores in the string x."
  987. (if (string-match "\\`\\(.*\\)#\\(.*\\)\\'" x)
  988. (math-string-restore-underscores
  989. (concat (math-match-substring x 1) "_" (math-match-substring x 2)))
  990. x))
  991. ;;;###autoload
  992. (defun math-read-if (cond op)
  993. (let ((then (math-read-expr-level 0)))
  994. (or (equal math-expr-data ":")
  995. (throw 'syntax "Expected ':'"))
  996. (math-read-token)
  997. (list 'calcFunc-if cond then (math-read-expr-level (nth 3 op)))))
  998. (defun math-factor-after ()
  999. (let ((math-exp-pos math-exp-pos)
  1000. math-exp-old-pos math-exp-token math-expr-data)
  1001. (math-read-token)
  1002. (or (memq math-exp-token '(number symbol dollar hash string))
  1003. (and (assoc math-expr-data '(("-") ("+") ("!") ("|") ("/")))
  1004. (assoc (concat "u" math-expr-data) math-expr-opers))
  1005. (eq (nth 2 (assoc math-expr-data math-expr-opers)) -1)
  1006. (assoc math-expr-data '(("(") ("[") ("{"))))))
  1007. (defun math-read-factor ()
  1008. (let ((math-expr-opers (math-expr-ops))
  1009. op)
  1010. (cond ((eq math-exp-token 'number)
  1011. (let ((num (math-read-number math-expr-data)))
  1012. (if (not num)
  1013. (progn
  1014. (setq math-exp-old-pos math-exp-pos)
  1015. (throw 'syntax "Bad format")))
  1016. (math-read-token)
  1017. (if (and math-read-expr-quotes
  1018. (consp num))
  1019. (list 'quote num)
  1020. num)))
  1021. ((and calc-user-parse-table
  1022. (setq op (calc-check-user-syntax)))
  1023. op)
  1024. ((or (equal math-expr-data "-")
  1025. (equal math-expr-data "+")
  1026. (equal math-expr-data "!")
  1027. (equal math-expr-data "|")
  1028. (equal math-expr-data "/"))
  1029. (setq math-expr-data (concat "u" math-expr-data))
  1030. (math-read-factor))
  1031. ((and (setq op (assoc math-expr-data math-expr-opers))
  1032. (eq (nth 2 op) -1))
  1033. (if (consp (nth 1 op))
  1034. (funcall (car (nth 1 op)) op)
  1035. (math-read-token)
  1036. (let ((val (math-read-expr-level (nth 3 op))))
  1037. (cond ((eq (nth 1 op) 'ident)
  1038. val)
  1039. ((and (Math-numberp val)
  1040. (equal (car op) "u-"))
  1041. (math-neg val))
  1042. (t (list (nth 1 op) val))))))
  1043. ((eq math-exp-token 'symbol)
  1044. (let ((sym (intern math-expr-data)))
  1045. (math-read-token)
  1046. (if (equal math-expr-data calc-function-open)
  1047. (let ((f (assq sym math-expr-function-mapping)))
  1048. (math-read-token)
  1049. (if (consp (cdr f))
  1050. (funcall (car (cdr f)) f sym)
  1051. (let ((args (if (or (equal math-expr-data calc-function-close)
  1052. (eq math-exp-token 'end))
  1053. nil
  1054. (math-read-expr-list))))
  1055. (if (not (or (equal math-expr-data calc-function-close)
  1056. (eq math-exp-token 'end)))
  1057. (throw 'syntax "Expected `)'"))
  1058. (math-read-token)
  1059. (if (and (memq calc-language
  1060. calc-lang-parens-are-subscripts)
  1061. args
  1062. (require 'calc-ext)
  1063. (let ((calc-matrix-mode 'scalar))
  1064. (math-known-matrixp
  1065. (list 'var sym
  1066. (intern
  1067. (concat "var-"
  1068. (symbol-name sym)))))))
  1069. (math-parse-fortran-subscr sym args)
  1070. (if f
  1071. (setq sym (cdr f))
  1072. (and (= (aref (symbol-name sym) 0) ?\\)
  1073. (< (prefix-numeric-value calc-language-option)
  1074. 0)
  1075. (setq sym (intern (substring (symbol-name sym)
  1076. 1))))
  1077. (or (string-match "-" (symbol-name sym))
  1078. (setq sym (intern
  1079. (concat "calcFunc-"
  1080. (symbol-name sym))))))
  1081. (cons sym args)))))
  1082. (if math-read-expr-quotes
  1083. sym
  1084. (let ((val (list 'var
  1085. (intern (math-remove-dashes
  1086. (symbol-name sym)))
  1087. (if (string-match "-" (symbol-name sym))
  1088. sym
  1089. (intern (concat "var-"
  1090. (symbol-name sym)))))))
  1091. (let ((v (or
  1092. (assq (nth 1 val) math-expr-variable-mapping)
  1093. (assq (math-restore-placeholders (nth 1 val))
  1094. math-expr-variable-mapping))))
  1095. (and v (setq val (if (consp (cdr v))
  1096. (funcall (car (cdr v)) v val)
  1097. (list 'var
  1098. (intern
  1099. (substring (symbol-name (cdr v))
  1100. 4))
  1101. (cdr v))))))
  1102. (while (and (memq calc-language
  1103. calc-lang-brackets-are-subscripts)
  1104. (equal math-expr-data "["))
  1105. (math-read-token)
  1106. (let ((el (math-read-expr-list)))
  1107. (while el
  1108. (setq val (append (list 'calcFunc-subscr val)
  1109. (list (car el))))
  1110. (setq el (cdr el))))
  1111. (if (equal math-expr-data "]")
  1112. (math-read-token)
  1113. (throw 'syntax "Expected ']'")))
  1114. val)))))
  1115. ((eq math-exp-token 'dollar)
  1116. (let ((abs (if (> math-expr-data 0) math-expr-data (- math-expr-data))))
  1117. (if (>= (length calc-dollar-values) abs)
  1118. (let ((num math-expr-data))
  1119. (math-read-token)
  1120. (setq calc-dollar-used (max calc-dollar-used num))
  1121. (math-check-complete (nth (1- abs) calc-dollar-values)))
  1122. (throw 'syntax (if calc-dollar-values
  1123. "Too many $'s"
  1124. "$'s not allowed in this context")))))
  1125. ((eq math-exp-token 'hash)
  1126. (or calc-hashes-used
  1127. (throw 'syntax "#'s not allowed in this context"))
  1128. (require 'calc-ext)
  1129. (if (<= math-expr-data (length calc-arg-values))
  1130. (let ((num math-expr-data))
  1131. (math-read-token)
  1132. (setq calc-hashes-used (max calc-hashes-used num))
  1133. (nth (1- num) calc-arg-values))
  1134. (throw 'syntax "Too many # arguments")))
  1135. ((equal math-expr-data "(")
  1136. (let* ((exp (let ((math-exp-keep-spaces nil))
  1137. (math-read-token)
  1138. (if (or (equal math-expr-data "\\dots")
  1139. (equal math-expr-data "\\ldots"))
  1140. '(neg (var inf var-inf))
  1141. (math-read-expr-level 0)))))
  1142. (let ((math-exp-keep-spaces nil))
  1143. (cond
  1144. ((equal math-expr-data ",")
  1145. (progn
  1146. (math-read-token)
  1147. (let ((exp2 (math-read-expr-level 0)))
  1148. (setq exp
  1149. (if (and exp2 (Math-realp exp) (Math-realp exp2))
  1150. (math-normalize (list 'cplx exp exp2))
  1151. (list '+ exp (list '* exp2 '(var i var-i))))))))
  1152. ((equal math-expr-data ";")
  1153. (progn
  1154. (math-read-token)
  1155. (let ((exp2 (math-read-expr-level 0)))
  1156. (setq exp (if (and exp2 (Math-realp exp)
  1157. (Math-anglep exp2))
  1158. (math-normalize (list 'polar exp exp2))
  1159. (require 'calc-ext)
  1160. (list '* exp
  1161. (list 'calcFunc-exp
  1162. (list '*
  1163. (math-to-radians-2 exp2)
  1164. '(var i var-i)))))))))
  1165. ((or (equal math-expr-data "\\dots")
  1166. (equal math-expr-data "\\ldots"))
  1167. (progn
  1168. (math-read-token)
  1169. (let ((exp2 (if (or (equal math-expr-data ")")
  1170. (equal math-expr-data "]")
  1171. (eq math-exp-token 'end))
  1172. '(var inf var-inf)
  1173. (math-read-expr-level 0))))
  1174. (setq exp
  1175. (list 'intv
  1176. (if (equal math-expr-data ")") 0 1)
  1177. exp
  1178. exp2)))))))
  1179. (if (not (or (equal math-expr-data ")")
  1180. (and (equal math-expr-data "]") (eq (car-safe exp) 'intv))
  1181. (eq math-exp-token 'end)))
  1182. (throw 'syntax "Expected `)'"))
  1183. (math-read-token)
  1184. exp))
  1185. ((eq math-exp-token 'string)
  1186. (require 'calc-ext)
  1187. (math-read-string))
  1188. ((equal math-expr-data "[")
  1189. (require 'calc-ext)
  1190. (math-read-brackets t "]"))
  1191. ((equal math-expr-data "{")
  1192. (require 'calc-ext)
  1193. (math-read-brackets nil "}"))
  1194. ((equal math-expr-data "<")
  1195. (require 'calc-ext)
  1196. (math-read-angle-brackets))
  1197. (t (throw 'syntax "Expected a number")))))
  1198. (provide 'calc-aent)
  1199. ;; Local variables:
  1200. ;; coding: utf-8
  1201. ;; generated-autoload-file: "calc-loaddefs.el"
  1202. ;; End:
  1203. ;;; calc-aent.el ends here