922 |
report-calc-bug) |
report-calc-bug) |
923 |
|
|
924 |
)) |
)) |
|
|
|
925 |
) |
) |
926 |
|
|
927 |
(calc-init-base) |
(calc-init-base) |
946 |
(define-key calc-dispatch-map (substring keys 0 1) nil)) |
(define-key calc-dispatch-map (substring keys 0 1) nil)) |
947 |
(define-key calc-dispatch-map keys 'calc-same-interface)))) |
(define-key calc-dispatch-map keys 'calc-same-interface)))) |
948 |
(error nil)) |
(error nil)) |
949 |
(calc-do-dispatch arg) |
(calc-do-dispatch arg)) |
|
) |
|
950 |
|
|
951 |
(defun calc-do-dispatch (arg) |
(defun calc-do-dispatch (arg) |
952 |
(let ((key (calc-read-key-sequence |
(let ((key (calc-read-key-sequence |
961 |
(progn |
(progn |
962 |
(or (commandp key) (calc-extensions)) |
(or (commandp key) (calc-extensions)) |
963 |
(call-interactively key)) |
(call-interactively key)) |
964 |
(beep))) |
(beep)))) |
|
) |
|
965 |
(setq calc-dispatch-help nil) |
(setq calc-dispatch-help nil) |
966 |
|
|
967 |
(defun calc-read-key-sequence (prompt map) |
(defun calc-read-key-sequence (prompt map) |
981 |
(char-to-string (cdr key))))) |
(char-to-string (cdr key))))) |
982 |
"" prompt2))) |
"" prompt2))) |
983 |
(use-global-map glob) |
(use-global-map glob) |
984 |
(use-local-map loc)))) |
(use-local-map loc))))) |
|
) |
|
985 |
|
|
986 |
|
|
987 |
|
|
1061 |
(eval (cons 'progn calc-defs)) |
(eval (cons 'progn calc-defs)) |
1062 |
(setq calc-defs nil) |
(setq calc-defs nil) |
1063 |
(calc-set-mode-line))) |
(calc-set-mode-line))) |
1064 |
(calc-check-defines) |
(calc-check-defines)) |
|
) |
|
1065 |
|
|
1066 |
(defun calc-check-defines () |
(defun calc-check-defines () |
1067 |
(if (symbol-plist 'calc-define) |
(if (symbol-plist 'calc-define) |
1079 |
(setq plist (cdr (cdr plist)))) |
(setq plist (cdr (cdr plist)))) |
1080 |
;; See if this has added any more calc-define properties. |
;; See if this has added any more calc-define properties. |
1081 |
(calc-check-defines)) |
(calc-check-defines)) |
1082 |
(setplist 'calc-define nil)))) |
(setplist 'calc-define nil))))) |
|
) |
|
1083 |
(setq calc-check-defines 'calc-check-defines) ; suitable for run-hooks |
(setq calc-check-defines 'calc-check-defines) ; suitable for run-hooks |
1084 |
|
|
1085 |
(defun calc-trail-mode (&optional buf) |
(defun calc-trail-mode (&optional buf) |
1109 |
(let ((buffer-read-only nil)) |
(let ((buffer-read-only nil)) |
1110 |
(insert "Emacs Calculator v" calc-version " by Dave Gillespie, " |
(insert "Emacs Calculator v" calc-version " by Dave Gillespie, " |
1111 |
"installed " calc-installed-date "\n"))) |
"installed " calc-installed-date "\n"))) |
1112 |
(run-hooks 'calc-trail-mode-hook) |
(run-hooks 'calc-trail-mode-hook)) |
|
) |
|
1113 |
|
|
1114 |
(defun calc-create-buffer () |
(defun calc-create-buffer () |
1115 |
(set-buffer (get-buffer-create "*Calculator*")) |
(set-buffer (get-buffer-create "*Calculator*")) |
1121 |
(if calc-language |
(if calc-language |
1122 |
(progn |
(progn |
1123 |
(calc-extensions) |
(calc-extensions) |
1124 |
(calc-set-language calc-language calc-language-option t))) |
(calc-set-language calc-language calc-language-option t)))) |
|
) |
|
1125 |
|
|
1126 |
;;;###autoload |
;;;###autoload |
1127 |
(defun calc (&optional arg full-display interactive) |
(defun calc (&optional arg full-display interactive) |
1183 |
(progn |
(progn |
1184 |
(sit-for 2) |
(sit-for 2) |
1185 |
(message ""))) |
(message ""))) |
1186 |
(setq calc-said-hello t)))) |
(setq calc-said-hello t))))) |
|
) |
|
1187 |
|
|
1188 |
;;;###autoload |
;;;###autoload |
1189 |
(defun full-calc () |
(defun full-calc () |
1190 |
"Invoke the Calculator and give it a full-sized window." |
"Invoke the Calculator and give it a full-sized window." |
1191 |
(interactive) |
(interactive) |
1192 |
(calc nil t (interactive-p)) |
(calc nil t (interactive-p))) |
|
) |
|
1193 |
|
|
1194 |
(defun calc-same-interface (arg) |
(defun calc-same-interface (arg) |
1195 |
"Invoke the Calculator using the most recent interface (calc or calc-keypad)." |
"Invoke the Calculator using the most recent interface (calc or calc-keypad)." |
1203 |
(MacEdit-finish-edit) |
(MacEdit-finish-edit) |
1204 |
(if calc-was-keypad-mode |
(if calc-was-keypad-mode |
1205 |
(calc-keypad) |
(calc-keypad) |
1206 |
(calc arg calc-full-mode t))))) |
(calc arg calc-full-mode t)))))) |
|
) |
|
1207 |
|
|
1208 |
|
|
1209 |
(defun calc-quit (&optional non-fatal) |
(defun calc-quit (&optional non-fatal) |
1242 |
(delete-windows-on kbuf)) |
(delete-windows-on kbuf)) |
1243 |
(bury-buffer buf) |
(bury-buffer buf) |
1244 |
(bury-buffer calc-trail-buffer) |
(bury-buffer calc-trail-buffer) |
1245 |
(and kbuf (bury-buffer kbuf)))))) |
(and kbuf (bury-buffer kbuf))))))) |
|
) |
|
1246 |
|
|
1247 |
;;;###autoload |
;;;###autoload |
1248 |
(defun quick-calc () |
(defun quick-calc () |
1249 |
"Do a quick calculation in the minibuffer without invoking full Calculator." |
"Do a quick calculation in the minibuffer without invoking full Calculator." |
1250 |
(interactive) |
(interactive) |
1251 |
(calc-do-quick-calc) |
(calc-do-quick-calc)) |
|
) |
|
1252 |
|
|
1253 |
;;;###autoload |
;;;###autoload |
1254 |
(defun calc-eval (str &optional separator &rest args) |
(defun calc-eval (str &optional separator &rest args) |
1255 |
"Do a quick calculation and return the result as a string. |
"Do a quick calculation and return the result as a string. |
1256 |
Return value will either be the formatted result in string form, |
Return value will either be the formatted result in string form, |
1257 |
or a list containing a character position and an error message in string form." |
or a list containing a character position and an error message in string form." |
1258 |
(calc-do-calc-eval str separator args) |
(calc-do-calc-eval str separator args)) |
|
) |
|
1259 |
|
|
1260 |
;;;###autoload |
;;;###autoload |
1261 |
(defun calc-keypad () |
(defun calc-keypad () |
1265 |
Or, position the cursor manually and do M-x calc-keypad-press." |
Or, position the cursor manually and do M-x calc-keypad-press." |
1266 |
(interactive) |
(interactive) |
1267 |
(calc-extensions) |
(calc-extensions) |
1268 |
(calc-do-keypad calc-full-mode (interactive-p)) |
(calc-do-keypad calc-full-mode (interactive-p))) |
|
) |
|
1269 |
|
|
1270 |
;;;###autoload |
;;;###autoload |
1271 |
(defun full-calc-keypad () |
(defun full-calc-keypad () |
1273 |
See calc-keypad for details." |
See calc-keypad for details." |
1274 |
(interactive) |
(interactive) |
1275 |
(calc-extensions) |
(calc-extensions) |
1276 |
(calc-do-keypad t (interactive-p)) |
(calc-do-keypad t (interactive-p))) |
|
) |
|
1277 |
|
|
1278 |
|
|
1279 |
;;; Note that modifications to this function may break calc-pass-errors. |
;;; Note that modifications to this function may break calc-pass-errors. |
1351 |
(calc-set-mode-line) |
(calc-set-mode-line) |
1352 |
(and calc-embedded-info |
(and calc-embedded-info |
1353 |
(calc-embedded-finish-command)))) |
(calc-embedded-finish-command)))) |
1354 |
(identity nil) ; allow a GC after timing is done |
(identity nil)) ; allow a GC after timing is done |
1355 |
) |
|
1356 |
(setq calc-aborted-prefix nil) |
(setq calc-aborted-prefix nil) |
1357 |
(setq calc-start-time nil) |
(setq calc-start-time nil) |
1358 |
|
|
1359 |
(defun calc-set-command-flag (f) |
(defun calc-set-command-flag (f) |
1360 |
(if (not (memq f calc-command-flags)) |
(if (not (memq f calc-command-flags)) |
1361 |
(setq calc-command-flags (cons f calc-command-flags))) |
(setq calc-command-flags (cons f calc-command-flags)))) |
|
) |
|
1362 |
|
|
1363 |
(defun calc-select-buffer () |
(defun calc-select-buffer () |
1364 |
(or (eq major-mode 'calc-mode) |
(or (eq major-mode 'calc-mode) |
1367 |
(let ((buf (get-buffer "*Calculator*"))) |
(let ((buf (get-buffer "*Calculator*"))) |
1368 |
(if buf |
(if buf |
1369 |
(set-buffer buf) |
(set-buffer buf) |
1370 |
(error "Calculator buffer not available"))))) |
(error "Calculator buffer not available")))))) |
|
) |
|
1371 |
|
|
1372 |
(defun calc-cursor-stack-index (&optional index) |
(defun calc-cursor-stack-index (&optional index) |
1373 |
(goto-char (point-max)) |
(goto-char (point-max)) |
1374 |
(forward-line (- (calc-substack-height (or index 1)))) |
(forward-line (- (calc-substack-height (or index 1))))) |
|
) |
|
1375 |
|
|
1376 |
(defun calc-stack-size () |
(defun calc-stack-size () |
1377 |
(- (length calc-stack) calc-stack-top) |
(- (length calc-stack) calc-stack-top)) |
|
) |
|
1378 |
|
|
1379 |
(defun calc-substack-height (n) |
(defun calc-substack-height (n) |
1380 |
(let ((sum 0) |
(let ((sum 0) |
1384 |
(setq sum (+ sum (nth 1 (car stack))) |
(setq sum (+ sum (nth 1 (car stack))) |
1385 |
n (1- n) |
n (1- n) |
1386 |
stack (cdr stack))) |
stack (cdr stack))) |
1387 |
sum) |
sum)) |
|
) |
|
1388 |
|
|
1389 |
(defun calc-set-mode-line () |
(defun calc-set-mode-line () |
1390 |
(save-excursion |
(save-excursion |
1489 |
nil |
nil |
1490 |
(setq mode-line-buffer-identification new-mode-string) |
(setq mode-line-buffer-identification new-mode-string) |
1491 |
(set-buffer-modified-p (buffer-modified-p)) |
(set-buffer-modified-p (buffer-modified-p)) |
1492 |
(and calc-embedded-info (calc-embedded-mode-line-change))))) |
(and calc-embedded-info (calc-embedded-mode-line-change)))))) |
|
) |
|
1493 |
|
|
1494 |
(defun calc-align-stack-window () |
(defun calc-align-stack-window () |
1495 |
(if (eq major-mode 'calc-mode) |
(if (eq major-mode 'calc-mode) |
1505 |
(goto-char (1- (match-end 0))))) |
(goto-char (1- (match-end 0))))) |
1506 |
(save-excursion |
(save-excursion |
1507 |
(calc-select-buffer) |
(calc-select-buffer) |
1508 |
(calc-align-stack-window))) |
(calc-align-stack-window)))) |
|
) |
|
1509 |
|
|
1510 |
(defun calc-check-stack (n) |
(defun calc-check-stack (n) |
1511 |
(if (> n (calc-stack-size)) |
(if (> n (calc-stack-size)) |
1512 |
(error "Too few elements on stack")) |
(error "Too few elements on stack")) |
1513 |
(if (< n 0) |
(if (< n 0) |
1514 |
(error "Invalid argument")) |
(error "Invalid argument"))) |
|
) |
|
1515 |
|
|
1516 |
(defun calc-push-list (vals &optional m sels) |
(defun calc-push-list (vals &optional m sels) |
1517 |
(while vals |
(while vals |
1532 |
(calc-record-undo (list 'push mm)) |
(calc-record-undo (list 'push mm)) |
1533 |
(calc-set-command-flag 'renum-stack)))) |
(calc-set-command-flag 'renum-stack)))) |
1534 |
(setq vals (cdr vals) |
(setq vals (cdr vals) |
1535 |
sels (cdr sels))) |
sels (cdr sels)))) |
|
) |
|
1536 |
|
|
1537 |
(defun calc-pop-push-list (n vals &optional m sels) |
(defun calc-pop-push-list (n vals &optional m sels) |
1538 |
(if (and calc-any-selections (null sels)) |
(if (and calc-any-selections (null sels)) |
1539 |
(calc-replace-selections n vals m) |
(calc-replace-selections n vals m) |
1540 |
(calc-pop-stack n m sels) |
(calc-pop-stack n m sels) |
1541 |
(calc-push-list vals m sels)) |
(calc-push-list vals m sels))) |
|
) |
|
1542 |
|
|
1543 |
(defun calc-pop-push-record-list (n prefix vals &optional m sels) |
(defun calc-pop-push-record-list (n prefix vals &optional m sels) |
1544 |
(or (and (consp vals) |
(or (and (consp vals) |
1551 |
(if (cdr vals) |
(if (cdr vals) |
1552 |
(calc-record-list vals prefix) |
(calc-record-list vals prefix) |
1553 |
(calc-record (car vals) prefix))) |
(calc-record (car vals) prefix))) |
1554 |
(calc-pop-push-list n vals m sels) |
(calc-pop-push-list n vals m sels)) |
|
) |
|
1555 |
|
|
1556 |
(defun calc-enter-result (n prefix vals &optional m) |
(defun calc-enter-result (n prefix vals &optional m) |
1557 |
(setq calc-aborted-prefix prefix) |
(setq calc-aborted-prefix prefix) |
1567 |
(if (equal vals '((nil))) |
(if (equal vals '((nil))) |
1568 |
(setq vals nil)) |
(setq vals nil)) |
1569 |
(calc-pop-push-record-list n prefix vals m) |
(calc-pop-push-record-list n prefix vals m) |
1570 |
(calc-handle-whys) |
(calc-handle-whys)) |
|
) |
|
1571 |
|
|
1572 |
(defun calc-normalize (val) |
(defun calc-normalize (val) |
1573 |
(if (memq calc-simplify-mode '(nil none num)) |
(if (memq calc-simplify-mode '(nil none num)) |
1574 |
(math-normalize val) |
(math-normalize val) |
1575 |
(calc-extensions) |
(calc-extensions) |
1576 |
(calc-normalize-fancy val)) |
(calc-normalize-fancy val))) |
|
) |
|
1577 |
|
|
1578 |
(defun calc-handle-whys () |
(defun calc-handle-whys () |
1579 |
(if calc-next-why |
(if calc-next-why |
1580 |
(calc-do-handle-whys)) |
(calc-do-handle-whys))) |
|
) |
|
1581 |
|
|
1582 |
|
|
1583 |
(defun calc-pop-stack (&optional n m sel-ok) ; pop N objs at level M of stack. |
(defun calc-pop-stack (&optional n m sel-ok) ; pop N objs at level M of stack. |
1605 |
(calc-cursor-stack-index n) |
(calc-cursor-stack-index n) |
1606 |
(setq calc-stack (nthcdr n calc-stack)) |
(setq calc-stack (nthcdr n calc-stack)) |
1607 |
(delete-region (point) (point-max)))) |
(delete-region (point) (point-max)))) |
1608 |
(calc-set-command-flag 'renum-stack))))) |
(calc-set-command-flag 'renum-stack)))))) |
|
) |
|
1609 |
|
|
1610 |
(defun calc-get-stack-element (x) |
(defun calc-get-stack-element (x) |
1611 |
(cond ((eq sel-mode 'entry) |
(cond ((eq sel-mode 'entry) |
1618 |
(car x)) |
(car x)) |
1619 |
(sel-mode |
(sel-mode |
1620 |
(calc-sel-error)) |
(calc-sel-error)) |
1621 |
(t (nth 2 x))) |
(t (nth 2 x)))) |
|
) |
|
1622 |
|
|
1623 |
;; Get the Nth element of the stack (N=1 is the top element). |
;; Get the Nth element of the stack (N=1 is the top element). |
1624 |
(defun calc-top (&optional n sel-mode) |
(defun calc-top (&optional n sel-mode) |
1625 |
(or n (setq n 1)) |
(or n (setq n 1)) |
1626 |
(calc-check-stack n) |
(calc-check-stack n) |
1627 |
(calc-get-stack-element (nth (+ n calc-stack-top -1) calc-stack)) |
(calc-get-stack-element (nth (+ n calc-stack-top -1) calc-stack))) |
|
) |
|
1628 |
|
|
1629 |
(defun calc-top-n (&optional n sel-mode) ; in case precision has changed |
(defun calc-top-n (&optional n sel-mode) ; in case precision has changed |
1630 |
(math-check-complete (calc-normalize (calc-top n sel-mode))) |
(math-check-complete (calc-normalize (calc-top n sel-mode)))) |
|
) |
|
1631 |
|
|
1632 |
(defun calc-top-list (&optional n m sel-mode) |
(defun calc-top-list (&optional n m sel-mode) |
1633 |
(or n (setq n 1)) |
(or n (setq n 1)) |
1637 |
(let ((top (copy-sequence (nthcdr (+ m calc-stack-top -1) |
(let ((top (copy-sequence (nthcdr (+ m calc-stack-top -1) |
1638 |
calc-stack)))) |
calc-stack)))) |
1639 |
(setcdr (nthcdr (1- n) top) nil) |
(setcdr (nthcdr (1- n) top) nil) |
1640 |
(nreverse (mapcar 'calc-get-stack-element top)))) |
(nreverse (mapcar 'calc-get-stack-element top))))) |
|
) |
|
1641 |
|
|
1642 |
(defun calc-top-list-n (&optional n m sel-mode) |
(defun calc-top-list-n (&optional n m sel-mode) |
1643 |
(mapcar 'math-check-complete |
(mapcar 'math-check-complete |
1644 |
(mapcar 'calc-normalize (calc-top-list n m sel-mode))) |
(mapcar 'calc-normalize (calc-top-list n m sel-mode)))) |
|
) |
|
1645 |
|
|
1646 |
|
|
1647 |
(defun calc-renumber-stack () |
(defun calc-renumber-stack () |
1673 |
(beginning-of-line) |
(beginning-of-line) |
1674 |
(setq lnum (1+ lnum) |
(setq lnum (1+ lnum) |
1675 |
stack (cdr stack)))))) |
stack (cdr stack)))))) |
1676 |
(and calc-embedded-info (calc-embedded-stack-change)) |
(and calc-embedded-info (calc-embedded-stack-change))) |
|
) |
|
1677 |
|
|
1678 |
(defun calc-refresh (&optional align) |
(defun calc-refresh (&optional align) |
1679 |
(interactive) |
(interactive) |
1706 |
(save-excursion |
(save-excursion |
1707 |
(set-buffer (aref calc-embedded-info 1)) |
(set-buffer (aref calc-embedded-info 1)) |
1708 |
(calc-refresh align))) |
(calc-refresh align))) |
1709 |
(setq calc-refresh-count (1+ calc-refresh-count)) |
(setq calc-refresh-count (1+ calc-refresh-count))) |
|
) |
|
1710 |
|
|
1711 |
|
|
1712 |
(defun calc-x-paste-text (arg) |
(defun calc-x-paste-text (arg) |
1725 |
(if (eq (car-safe val) 'error) |
(if (eq (car-safe val) 'error) |
1726 |
(error "%s in yanked data" (nth 2 val))))) |
(error "%s in yanked data" (nth 2 val))))) |
1727 |
(calc-enter-result 0 "Xynk" val)))) |
(calc-enter-result 0 "Xynk" val)))) |
1728 |
(x-paste-text arg)) |
(x-paste-text arg))) |
|
) |
|
1729 |
|
|
1730 |
|
|
1731 |
|
|
1735 |
(save-excursion |
(save-excursion |
1736 |
(let ((win (get-buffer-window (current-buffer)))) |
(let ((win (get-buffer-window (current-buffer)))) |
1737 |
(and win |
(and win |
1738 |
(pos-visible-in-window-p (1- (point-max)) win)))) |
(pos-visible-in-window-p (1- (point-max)) win))))) |
|
) |
|
1739 |
|
|
1740 |
(defun calc-trail-buffer () |
(defun calc-trail-buffer () |
1741 |
(and (or (null calc-trail-buffer) |
(and (or (null calc-trail-buffer) |
1754 |
(set-buffer calc-trail-buffer) |
(set-buffer calc-trail-buffer) |
1755 |
(goto-line 2) |
(goto-line 2) |
1756 |
(setq calc-trail-pointer (point-marker)))) |
(setq calc-trail-pointer (point-marker)))) |
1757 |
calc-trail-buffer |
calc-trail-buffer) |
|
) |
|
1758 |
|
|
1759 |
(defun calc-record (val &optional prefix) |
(defun calc-record (val &optional prefix) |
1760 |
(setq calc-aborted-prefix nil) |
(setq calc-aborted-prefix nil) |
1784 |
(if (and aligned win (not (memq 'hold-trail calc-command-flags))) |
(if (and aligned win (not (memq 'hold-trail calc-command-flags))) |
1785 |
(calc-trail-here)) |
(calc-trail-here)) |
1786 |
(goto-char (1- (point-max)))))))) |
(goto-char (1- (point-max)))))))) |
1787 |
val |
val) |
|
) |
|
1788 |
|
|
1789 |
|
|
1790 |
(defun calc-trail-display (flag &optional no-refresh) |
(defun calc-trail-display (flag &optional no-refresh) |
1813 |
(if (interactive-p) |
(if (interactive-p) |
1814 |
(calc-do-refresh) |
(calc-do-refresh) |
1815 |
(calc-refresh)))))))) |
(calc-refresh)))))))) |
1816 |
calc-trail-buffer |
calc-trail-buffer) |
|
) |
|
1817 |
|
|
1818 |
(defun calc-trail-here () |
(defun calc-trail-here () |
1819 |
(interactive) |
(interactive) |
1843 |
(set-buffer calc-main-buffer) |
(set-buffer calc-main-buffer) |
1844 |
(setq overlay-arrow-string calc-trail-overlay |
(setq overlay-arrow-string calc-trail-overlay |
1845 |
overlay-arrow-position calc-trail-pointer)))))) |
overlay-arrow-position calc-trail-pointer)))))) |
1846 |
(error "Not in Calc Trail buffer")) |
(error "Not in Calc Trail buffer"))) |
|
) |
|
1847 |
|
|
1848 |
|
|
1849 |
|
|
1857 |
(cdr calc-undo-list))) |
(cdr calc-undo-list))) |
1858 |
(setq calc-undo-list (cons (list rec) calc-undo-list) |
(setq calc-undo-list (cons (list rec) calc-undo-list) |
1859 |
calc-redo-list nil) |
calc-redo-list nil) |
1860 |
(calc-set-command-flag 'undo))) |
(calc-set-command-flag 'undo)))) |
|
) |
|
1861 |
|
|
1862 |
|
|
1863 |
|
|
1871 |
(mapcar 'math-check-complete |
(mapcar 'math-check-complete |
1872 |
(calc-top-list 2)))) |
(calc-top-list 2)))) |
1873 |
(calc-extensions) |
(calc-extensions) |
1874 |
(calc-binary-op-fancy name func arg ident unary)) |
(calc-binary-op-fancy name func arg ident unary))) |
|
) |
|
1875 |
|
|
1876 |
(defun calc-unary-op (name func arg &optional func2) |
(defun calc-unary-op (name func arg &optional func2) |
1877 |
(setq calc-aborted-prefix name) |
(setq calc-aborted-prefix name) |
1879 |
(calc-enter-result 1 name (list (or func2 func) |
(calc-enter-result 1 name (list (or func2 func) |
1880 |
(math-check-complete (calc-top 1)))) |
(math-check-complete (calc-top 1)))) |
1881 |
(calc-extensions) |
(calc-extensions) |
1882 |
(calc-unary-op-fancy name func arg)) |
(calc-unary-op-fancy name func arg))) |
|
) |
|
1883 |
|
|
1884 |
|
|
1885 |
(defun calc-plus (arg) |
(defun calc-plus (arg) |
1886 |
(interactive "P") |
(interactive "P") |
1887 |
(calc-slow-wrapper |
(calc-slow-wrapper |
1888 |
(calc-binary-op "+" 'calcFunc-add arg 0 nil '+)) |
(calc-binary-op "+" 'calcFunc-add arg 0 nil '+))) |
|
) |
|
1889 |
|
|
1890 |
(defun calc-minus (arg) |
(defun calc-minus (arg) |
1891 |
(interactive "P") |
(interactive "P") |
1892 |
(calc-slow-wrapper |
(calc-slow-wrapper |
1893 |
(calc-binary-op "-" 'calcFunc-sub arg 0 'neg '-)) |
(calc-binary-op "-" 'calcFunc-sub arg 0 'neg '-))) |
|
) |
|
1894 |
|
|
1895 |
(defun calc-times (arg) |
(defun calc-times (arg) |
1896 |
(interactive "P") |
(interactive "P") |
1897 |
(calc-slow-wrapper |
(calc-slow-wrapper |
1898 |
(calc-binary-op "*" 'calcFunc-mul arg 1 nil '*)) |
(calc-binary-op "*" 'calcFunc-mul arg 1 nil '*))) |
|
) |
|
1899 |
|
|
1900 |
(defun calc-divide (arg) |
(defun calc-divide (arg) |
1901 |
(interactive "P") |
(interactive "P") |
1902 |
(calc-slow-wrapper |
(calc-slow-wrapper |
1903 |
(calc-binary-op "/" 'calcFunc-div arg 0 'calcFunc-inv '/)) |
(calc-binary-op "/" 'calcFunc-div arg 0 'calcFunc-inv '/))) |
|
) |
|
1904 |
|
|
1905 |
|
|
1906 |
(defun calc-change-sign (arg) |
(defun calc-change-sign (arg) |
1907 |
(interactive "P") |
(interactive "P") |
1908 |
(calc-wrapper |
(calc-wrapper |
1909 |
(calc-unary-op "chs" 'neg arg)) |
(calc-unary-op "chs" 'neg arg))) |
|
) |
|
1910 |
|
|
1911 |
|
|
1912 |
|
|
1920 |
((= n 0) |
((= n 0) |
1921 |
(calc-push-list (calc-top-list (calc-stack-size)))) |
(calc-push-list (calc-top-list (calc-stack-size)))) |
1922 |
(t |
(t |
1923 |
(calc-push-list (calc-top-list n))))) |
(calc-push-list (calc-top-list n)))))) |
|
) |
|
1924 |
|
|
1925 |
|
|
1926 |
(defun calc-pop (n) |
(defun calc-pop (n) |
1946 |
(= nn 1) |
(= nn 1) |
1947 |
(calc-top-selected 1 1)) |
(calc-top-selected 1 1)) |
1948 |
(calc-delete-selection 1) |
(calc-delete-selection 1) |
1949 |
(calc-pop-stack nn)))))) |
(calc-pop-stack nn))))))) |
|
) |
|
1950 |
|
|
1951 |
|
|
1952 |
|
|
1988 |
(if (eq calc-prev-char 'dots) |
(if (eq calc-prev-char 'dots) |
1989 |
(progn |
(progn |
1990 |
(calc-extensions) |
(calc-extensions) |
1991 |
(calc-dots)))))) |
(calc-dots))))))) |
|
) |
|
1992 |
|
|
1993 |
(defsubst calc-minibuffer-size () |
(defsubst calc-minibuffer-size () |
1994 |
(- (point-max) (minibuffer-prompt-end))) |
(- (point-max) (minibuffer-prompt-end))) |
2012 |
(>= last-input-char 128)) |
(>= last-input-char 128)) |
2013 |
last-input-char |
last-input-char |
2014 |
nil)))) |
nil)))) |
2015 |
(exit-minibuffer)) |
(exit-minibuffer))) |
|
) |
|
2016 |
|
|
2017 |
|
|
2018 |
(defun calc-minibuffer-contains (rex) |
(defun calc-minibuffer-contains (rex) |
2019 |
(save-excursion |
(save-excursion |
2020 |
(goto-char (minibuffer-prompt-end)) |
(goto-char (minibuffer-prompt-end)) |
2021 |
(looking-at rex)) |
(looking-at rex))) |
|
) |
|
2022 |
|
|
2023 |
(defun calcDigit-key () |
(defun calcDigit-key () |
2024 |
(interactive) |
(interactive) |
2117 |
(beep) |
(beep) |
2118 |
(calc-temp-minibuffer-message " [Bad format]")))))) |
(calc-temp-minibuffer-message " [Bad format]")))))) |
2119 |
(setq calc-prev-prev-char calc-prev-char |
(setq calc-prev-prev-char calc-prev-char |
2120 |
calc-prev-char last-command-char) |
calc-prev-char last-command-char)) |
|
) |
|
2121 |
|
|
2122 |
|
|
2123 |
(defun calcDigit-backspace () |
(defun calcDigit-backspace () |
2135 |
(if (= (calc-minibuffer-size) 0) |
(if (= (calc-minibuffer-size) 0) |
2136 |
(progn |
(progn |
2137 |
(setq last-command-char 13) |
(setq last-command-char 13) |
2138 |
(calcDigit-nondigit))) |
(calcDigit-nondigit)))) |
|
) |
|
2139 |
|
|
2140 |
|
|
2141 |
|
|
2342 |
(calc-record-why "*Variable is void" (nth 1 err))))) |
(calc-record-why "*Variable is void" (nth 1 err))))) |
2343 |
(if (consp (car a)) |
(if (consp (car a)) |
2344 |
(math-dimension-error) |
(math-dimension-error) |
2345 |
(cons (car a) args))))))) |
(cons (car a) args)))))))) |
|
) |
|
2346 |
|
|
2347 |
|
|
2348 |
|
|
2354 |
(math-floatp (nth 2 a)) |
(math-floatp (nth 2 a)) |
2355 |
(and (eq (car a) 'intv) (math-floatp (nth 3 a))))) |
(and (eq (car a) 'intv) (math-floatp (nth 3 a))))) |
2356 |
((eq (car-safe a) 'date) |
((eq (car-safe a) 'date) |
2357 |
(math-floatp (nth 1 a)))) |
(math-floatp (nth 1 a))))) |
|
) |
|
2358 |
|
|
2359 |
|
|
2360 |
|
|
2364 |
((eq (car-safe a) 'incomplete) |
((eq (car-safe a) 'incomplete) |
2365 |
(calc-incomplete-error a)) |
(calc-incomplete-error a)) |
2366 |
((consp a) a) |
((consp a) a) |
2367 |
(t (error "Invalid data object encountered"))) |
(t (error "Invalid data object encountered")))) |
|
) |
|
2368 |
|
|
2369 |
|
|
2370 |
|
|
2372 |
(defun math-bignum (a) |
(defun math-bignum (a) |
2373 |
(if (>= a 0) |
(if (>= a 0) |
2374 |
(cons 'bigpos (math-bignum-big a)) |
(cons 'bigpos (math-bignum-big a)) |
2375 |
(cons 'bigneg (math-bignum-big (- a)))) |
(cons 'bigneg (math-bignum-big (- a))))) |
|
) |
|
2376 |
|
|
2377 |
(defun math-bignum-big (a) ; [L s] |
(defun math-bignum-big (a) ; [L s] |
2378 |
(if (= a 0) |
(if (= a 0) |
2379 |
nil |
nil |
2380 |
(cons (% a 1000) (math-bignum-big (/ a 1000)))) |
(cons (% a 1000) (math-bignum-big (/ a 1000))))) |
|
) |
|
2381 |
|
|
2382 |
|
|
2383 |
;;; Build a normalized floating-point number. [F I S] |
;;; Build a normalized floating-point number. [F I S] |
2408 |
(if (and (>= exp 3000000) |
(if (and (>= exp 3000000) |
2409 |
(>= (+ exp (math-numdigs mant) -1) 4000000)) |
(>= (+ exp (math-numdigs mant) -1) 4000000)) |
2410 |
(signal 'math-overflow nil) |
(signal 'math-overflow nil) |
2411 |
(list 'float mant exp)))) |
(list 'float mant exp))))) |
|
) |
|
2412 |
|
|
2413 |
(defun math-div10-bignum (a) ; [l l] |
(defun math-div10-bignum (a) ; [l l] |
2414 |
(if (cdr a) |
(if (cdr a) |
2415 |
(cons (+ (/ (car a) 10) (* (% (nth 1 a) 10) 100)) |
(cons (+ (/ (car a) 10) (* (% (nth 1 a) 10) 100)) |
2416 |
(math-div10-bignum (cdr a))) |
(math-div10-bignum (cdr a))) |
2417 |
(list (/ (car a) 10))) |
(list (/ (car a) 10)))) |
|
) |
|
2418 |
|
|
2419 |
;;; Coerce A to be a float. [F N; V V] [Public] |
;;; Coerce A to be a float. [F N; V V] [Public] |
2420 |
(defun math-float (a) |
(defun math-float (a) |
2423 |
((eq (car a) 'float) a) |
((eq (car a) 'float) a) |
2424 |
((memq (car a) '(cplx polar vec hms date sdev mod)) |
((memq (car a) '(cplx polar vec hms date sdev mod)) |
2425 |
(cons (car a) (mapcar 'math-float (cdr a)))) |
(cons (car a) (mapcar 'math-float (cdr a)))) |
2426 |
(t (math-float-fancy a))) |
(t (math-float-fancy a)))) |
|
) |
|
2427 |
|
|
2428 |
|
|
2429 |
(defun math-neg (a) |
(defun math-neg (a) |
2434 |
(list (car a) (Math-integer-neg (nth 1 a)) (nth 2 a))) |
(list (car a) (Math-integer-neg (nth 1 a)) (nth 2 a))) |
2435 |
((memq (car a) '(cplx vec hms date calcFunc-idn)) |
((memq (car a) '(cplx vec hms date calcFunc-idn)) |
2436 |
(cons (car a) (mapcar 'math-neg (cdr a)))) |
(cons (car a) (mapcar 'math-neg (cdr a)))) |
2437 |
(t (math-neg-fancy a))) |
(t (math-neg-fancy a)))) |
|
) |
|
2438 |
|
|
2439 |
|
|
2440 |
;;; Compute the number of decimal digits in integer A. [S I] |
;;; Compute the number of decimal digits in integer A. [S I] |
2451 |
((= a 0) 0) |
((= a 0) 0) |
2452 |
((> a -10) 1) |
((> a -10) 1) |
2453 |
((> a -100) 2) |
((> a -100) 2) |
2454 |
(t (math-numdigs (- a))))) |
(t (math-numdigs (- a)))))) |
|
) |
|
2455 |
|
|
2456 |
;;; Multiply (with truncation toward 0) the integer A by 10^N. [I i S] |
;;; Multiply (with truncation toward 0) the integer A by 10^N. [I i S] |
2457 |
(defun math-scale-int (a n) |
(defun math-scale-int (a n) |
2458 |
(cond ((= n 0) a) |
(cond ((= n 0) a) |
2459 |
((> n 0) (math-scale-left a n)) |
((> n 0) (math-scale-left a n)) |
2460 |
(t (math-normalize (math-scale-right a (- n))))) |
(t (math-normalize (math-scale-right a (- n)))))) |
|
) |
|
2461 |
|
|
2462 |
(defun math-scale-left (a n) ; [I I S] |
(defun math-scale-left (a n) ; [I I S] |
2463 |
(if (= n 0) |
(if (= n 0) |
2474 |
(* a 100)) |
(* a 100)) |
2475 |
(if (or (>= a 100000) (<= a -100000)) |
(if (or (>= a 100000) (<= a -100000)) |
2476 |
(math-scale-left (math-bignum a) 1) |
(math-scale-left (math-bignum a) 1) |
2477 |
(* a 10)))))) |
(* a 10))))))) |
|
) |
|
2478 |
|
|
2479 |
(defun math-scale-left-bignum (a n) |
(defun math-scale-left-bignum (a n) |
2480 |
(if (>= n 3) |
(if (>= n 3) |
2482 |
n (- n 3)) 3))) |
n (- n 3)) 3))) |
2483 |
(if (> n 0) |
(if (> n 0) |
2484 |
(math-mul-bignum-digit a (if (= n 2) 100 10) 0) |
(math-mul-bignum-digit a (if (= n 2) 100 10) 0) |
2485 |
a) |
a)) |
|
) |
|
2486 |
|
|
2487 |
(defun math-scale-right (a n) ; [i i S] |
(defun math-scale-right (a n) ; [i i S] |
2488 |
(if (= n 0) |
(if (= n 0) |
2500 |
(/ a 100) |
(/ a 100) |
2501 |
(if (= n 1) |
(if (= n 1) |
2502 |
(/ a 10) |
(/ a 10) |
2503 |
a))))) |
a)))))) |
|
) |
|
2504 |
|
|
2505 |
(defun math-scale-right-bignum (a n) ; [L L S; l l S] |
(defun math-scale-right-bignum (a n) ; [L L S; l l S] |
2506 |
(if (>= n 3) |
(if (>= n 3) |
2508 |
n (% n 3))) |
n (% n 3))) |
2509 |
(if (> n 0) |
(if (> n 0) |
2510 |
(cdr (math-mul-bignum-digit a (if (= n 2) 10 100) 0)) |
(cdr (math-mul-bignum-digit a (if (= n 2) 10 100) 0)) |
2511 |
a) |
a)) |
|
) |
|
2512 |
|
|
2513 |
;;; Multiply (with rounding) the integer A by 10^N. [I i S] |
;;; Multiply (with rounding) the integer A by 10^N. [I i S] |
2514 |
(defun math-scale-rounding (a n) |
(defun math-scale-rounding (a n) |
2536 |
(- (math-scale-rounding (- a) n)) |
(- (math-scale-rounding (- a) n)) |
2537 |
(if (= n -1) |
(if (= n -1) |
2538 |
(/ (+ a 5) 10) |
(/ (+ a 5) 10) |
2539 |
(/ (+ (math-scale-right a (- -1 n)) 5) 10))))) |
(/ (+ (math-scale-right a (- -1 n)) 5) 10)))))) |
|
) |
|
2540 |
|
|
2541 |
|
|
2542 |
;;; Compute the sum of A and B. [O O O] [Public] |
;;; Compute the sum of A and B. [O O O] [Public] |
2586 |
(and (calc-extensions) |
(and (calc-extensions) |
2587 |
(math-add-objects-fancy a b)))) |
(math-add-objects-fancy a b)))) |
2588 |
(and (calc-extensions) |
(and (calc-extensions) |
2589 |
(math-add-symb-fancy a b))) |
(math-add-symb-fancy a b)))) |
|
) |
|
2590 |
|
|
2591 |
(defun math-add-bignum (a b) ; [L L L; l l l] |
(defun math-add-bignum (a b) ; [L L L; l l l] |
2592 |
(if a |
(if a |
2620 |
(nconc a b) |
(nconc a b) |
2621 |
a))) |
a))) |
2622 |
a) |
a) |
2623 |
b) |
b)) |
|
) |
|
2624 |
|
|
2625 |
(defun math-sub-bignum (a b) ; [l l l] |
(defun math-sub-bignum (a b) ; [l l l] |
2626 |
(if b |
(if b |
2658 |
(setq b (cdr b))) |
(setq b (cdr b))) |
2659 |
(and b |
(and b |
2660 |
'neg)) |
'neg)) |
2661 |
a) |
a)) |
|
) |
|
2662 |
|
|
2663 |
(defun math-add-float (a b) ; [F F F] |
(defun math-add-float (a b) ; [F F F] |
2664 |
(let ((ediff (- (nth 2 a) (nth 2 b)))) |
(let ((ediff (- (nth 2 a) (nth 2 b)))) |
2675 |
b |
b |
2676 |
(math-make-float (math-add (nth 1 a) |
(math-make-float (math-add (nth 1 a) |
2677 |
(math-scale-left (nth 1 b) ediff)) |
(math-scale-left (nth 1 b) ediff)) |
2678 |
(nth 2 a))))) |
(nth 2 a)))))) |
|
) |
|
2679 |
|
|
2680 |
;;; Compute the difference of A and B. [O O O] [Public] |
;;; Compute the difference of A and B. [O O O] [Public] |
2681 |
(defun math-sub (a b) |
(defun math-sub (a b) |
2684 |
(setq a (- a b)) |
(setq a (- a b)) |
2685 |
(if (or (<= a -1000000) (>= a 1000000)) |
(if (or (<= a -1000000) (>= a 1000000)) |
2686 |
(math-bignum a) |
(math-bignum a) |
2687 |
a)) |
a))) |
|
) |
|
2688 |
|
|
2689 |
(defun math-sub-float (a b) ; [F F F] |
(defun math-sub-float (a b) ; [F F F] |
2690 |
(let ((ediff (- (nth 2 a) (nth 2 b)))) |
(let ((ediff (- (nth 2 a) (nth 2 b)))) |
2702 |
(math-make-float (math-add (nth 1 a) |
(math-make-float (math-add (nth 1 a) |
2703 |
(Math-integer-neg |
(Math-integer-neg |
2704 |
(math-scale-left (nth 1 b) ediff))) |
(math-scale-left (nth 1 b) ediff))) |
2705 |
(nth 2 a))))) |
(nth 2 a)))))) |
|
) |
|
2706 |
|
|
2707 |
|
|
2708 |
;;; Compute the product of A and B. [O O O] [Public] |
;;; Compute the product of A and B. [O O O] [Public] |
2748 |
(and (calc-extensions) |
(and (calc-extensions) |
2749 |
(math-mul-objects-fancy a b)))) |
(math-mul-objects-fancy a b)))) |
2750 |
(and (calc-extensions) |
(and (calc-extensions) |
2751 |
(math-mul-symb-fancy a b))) |
(math-mul-symb-fancy a b)))) |
|
) |
|
2752 |
|
|
2753 |
(defun math-infinitep (a &optional undir) |
(defun math-infinitep (a &optional undir) |
2754 |
(while (and (consp a) (memq (car a) '(* / neg))) |
(while (and (consp a) (memq (car a) '(* / neg))) |
2760 |
(memq (nth 2 a) '(var-inf var-uinf var-nan)) |
(memq (nth 2 a) '(var-inf var-uinf var-nan)) |
2761 |
(if (and undir (eq (nth 2 a) 'var-inf)) |
(if (and undir (eq (nth 2 a) 'var-inf)) |
2762 |
'(var uinf var-uinf) |
'(var uinf var-uinf) |
2763 |
a)) |
a))) |
|
) |
|
2764 |
|
|
2765 |
;;; Multiply digit lists A and B. [L L L; l l l] |
;;; Multiply digit lists A and B. [L L L; l l l] |
2766 |
(defun math-mul-bignum (a b) |
(defun math-mul-bignum (a b) |
2786 |
(if (cdr ss) |
(if (cdr ss) |
2787 |
(setcar (cdr ss) (+ (/ prod 1000) (car (cdr ss)))) |
(setcar (cdr ss) (+ (/ prod 1000) (car (cdr ss)))) |
2788 |
(setcdr ss (list (/ prod 1000)))))) |
(setcdr ss (list (/ prod 1000)))))) |
2789 |
sum)) |
sum))) |
|
) |
|
2790 |
|
|
2791 |
;;; Multiply digit list A by digit D. [L L D D; l l D D] |
;;; Multiply digit list A by digit D. [L L D D; l l D D] |
2792 |
(defun math-mul-bignum-digit (a d c) |
(defun math-mul-bignum-digit (a d c) |
2803 |
(setcdr aa (list (/ prod 1000)))) |
(setcdr aa (list (/ prod 1000)))) |
2804 |
a)) |
a)) |
2805 |
(and (> c 0) |
(and (> c 0) |
2806 |
(list c))) |
(list c)))) |
|
) |
|
2807 |
|
|
2808 |
|
|
2809 |
;;; Compute the integer (quotient . remainder) of A and B, which may be |
;;; Compute the integer (quotient . remainder) of A and B, which may be |
2825 |
(math-normalize (cons (if (eq (car a) (car b)) 'bigpos 'bigneg) |
(math-normalize (cons (if (eq (car a) (car b)) 'bigpos 'bigneg) |
2826 |
(car res))) |
(car res))) |
2827 |
(math-normalize (cons (car a) (cdr res)))))) |
(math-normalize (cons (car a) (cdr res)))))) |
2828 |
(cons (/ a b) (% a b))) |
(cons (/ a b) (% a b)))) |
|
) |
|
2829 |
|
|
2830 |
(defun math-quotient (a b) ; [I I I] [Public] |
(defun math-quotient (a b) ; [I I I] [Public] |
2831 |
(if (and (not (consp a)) (not (consp b))) |
(if (and (not (consp a)) (not (consp b))) |
2846 |
(math-mul-bignum-digit (cdr b) d 0) |
(math-mul-bignum-digit (cdr b) d 0) |
2847 |
alen blen))) |
alen blen))) |
2848 |
(math-normalize (cons (if (eq (car a) (car b)) 'bigpos 'bigneg) |
(math-normalize (cons (if (eq (car a) (car b)) 'bigpos 'bigneg) |
2849 |
(car res)))))) |
(car res))))))) |
|
) |
|
2850 |
|
|
2851 |
|
|
2852 |
;;; Divide a bignum digit list by another. [l.l l L] |
;;; Divide a bignum digit list by another. [l.l l L] |
2864 |
(cons (car res) |
(cons (car res) |
2865 |
(car (math-div-bignum-digit (cdr res) d))))) |
(car (math-div-bignum-digit (cdr res) d))))) |
2866 |
(let ((res (math-div-bignum-digit a (car b)))) |
(let ((res (math-div-bignum-digit a (car b)))) |
2867 |
(cons (car res) (list (cdr res))))) |
(cons (car res) (list (cdr res)))))) |
|
) |
|
2868 |
|
|
2869 |
;;; Divide a bignum digit list by a digit. [l.D l D] |
;;; Divide a bignum digit list by a digit. [l.D l D] |
2870 |
(defun math-div-bignum-digit (a b) |
(defun math-div-bignum-digit (a b) |
2874 |
(cons |
(cons |
2875 |
(cons (/ num b) (car res)) |
(cons (/ num b) (car res)) |
2876 |
(% num b))) |
(% num b))) |
2877 |
'(nil . 0)) |
'(nil . 0))) |
|
) |
|
2878 |
|
|
2879 |
(defun math-div-bignum-big (a b alen blen) ; [l.l l L] |
(defun math-div-bignum-big (a b alen blen) ; [l.l l L] |
2880 |
(if (< alen blen) |
(if (< alen blen) |
2884 |
(res2 (math-div-bignum-part num b blen))) |
(res2 (math-div-bignum-part num b blen))) |
2885 |
(cons |
(cons |
2886 |
(cons (car res2) (car res)) |
(cons (car res2) (car res)) |
2887 |
(cdr res2)))) |
(cdr res2))))) |
|
) |
|
2888 |
|
|
2889 |
(defun math-div-bignum-part (a b blen) ; a < b*1000 [D.l l L] |
(defun math-div-bignum-part (a b blen) ; a < b*1000 [D.l l L] |
2890 |
(let* ((num (+ (* (or (nth blen a) 0) 1000) (or (nth (1- blen) a) 0))) |
(let* ((num (+ (* (or (nth blen a) 0) 1000) (or (nth (1- blen) a) 0))) |
2891 |
(den (nth (1- blen) b)) |
(den (nth (1- blen) b)) |
2892 |
(guess (min (/ num den) 999))) |
(guess (min (/ num den) 999))) |
2893 |
(math-div-bignum-try a b (math-mul-bignum-digit b guess 0) guess)) |
(math-div-bignum-try a b (math-mul-bignum-digit b guess 0) guess))) |
|
) |
|
2894 |
|
|
2895 |
(defun math-div-bignum-try (a b c guess) ; [D.l l l D] |
(defun math-div-bignum-try (a b c guess) ; [D.l l l D] |
2896 |
(let ((rem (math-sub-bignum a c))) |
(let ((rem (math-sub-bignum a c))) |
2897 |
(if (eq rem 'neg) |
(if (eq rem 'neg) |
2898 |
(math-div-bignum-try a b (math-sub-bignum c b) (1- guess)) |
(math-div-bignum-try a b (math-sub-bignum c b) (1- guess)) |
2899 |
(cons guess rem))) |
(cons guess rem)))) |
|
) |
|
2900 |
|
|
2901 |
|
|
2902 |
;;; Compute the quotient of A and B. [O O N] [Public] |
;;; Compute the quotient of A and B. [O O N] [Public] |
2935 |
(and (calc-extensions) |
(and (calc-extensions) |
2936 |
(math-div-objects-fancy a b)))) |
(math-div-objects-fancy a b)))) |
2937 |
(and (calc-extensions) |
(and (calc-extensions) |
2938 |
(math-div-symb-fancy a b))) |
(math-div-symb-fancy a b)))) |
|
) |
|
2939 |
|
|
2940 |
(defun math-div-float (a b) ; [F F F] |
(defun math-div-float (a b) ; [F F F] |
2941 |
(let ((ldiff (max (- (1+ calc-internal-prec) |
(let ((ldiff (max (- (1+ calc-internal-prec) |
2942 |
(- (math-numdigs (nth 1 a)) (math-numdigs (nth 1 b)))) |
(- (math-numdigs (nth 1 a)) (math-numdigs (nth 1 b)))) |
2943 |
0))) |
0))) |
2944 |
(math-make-float (math-quotient (math-scale-int (nth 1 a) ldiff) (nth 1 b)) |
(math-make-float (math-quotient (math-scale-int (nth 1 a) ldiff) (nth 1 b)) |
2945 |
(- (- (nth 2 a) (nth 2 b)) ldiff))) |
(- (- (nth 2 a) (nth 2 b)) ldiff)))) |
|
) |
|
2946 |
|
|
2947 |
|
|
2948 |
|
|
3006 |
(aset s 0 ?1) |
(aset s 0 ?1) |
3007 |
(aset s 1 ?:)))) |
(aset s 1 ?:)))) |
3008 |
(setcar (cdr entry) (calc-count-lines s)) |
(setcar (cdr entry) (calc-count-lines s)) |
3009 |
s) |
s)) |
|
) |
|
3010 |
|
|
3011 |
(defun math-stack-value-offset (c) |
(defun math-stack-value-offset (c) |
3012 |
(let* ((num (if calc-line-numbering 4 0)) |
(let* ((num (if calc-line-numbering 4 0)) |
3020 |
(if (integerp calc-line-breaking) |
(if (integerp calc-line-breaking) |
3021 |
(setq wid calc-line-breaking))) |
(setq wid calc-line-breaking))) |
3022 |
(cons (max (- off (length calc-left-label)) 0) |
(cons (max (- off (length calc-left-label)) 0) |
3023 |
(+ wid num))) |
(+ wid num)))) |
|
) |
|
3024 |
|
|
3025 |
(defun calc-count-lines (s) |
(defun calc-count-lines (s) |
3026 |
(let ((pos 0) |
(let ((pos 0) |
3028 |
(while (setq newpos (string-match "\n" s pos)) |
(while (setq newpos (string-match "\n" s pos)) |
3029 |
(setq pos (1+ newpos) |
(setq pos (1+ newpos) |
3030 |
num (1+ num))) |
num (1+ num))) |
3031 |
num) |
num)) |
|
) |
|
3032 |
|
|
3033 |
(defun math-format-value (a &optional w) |
(defun math-format-value (a &optional w) |
3034 |
(if (and (Math-scalarp a) |
(if (and (Math-scalarp a) |
3036 |
(math-format-number a) |
(math-format-number a) |
3037 |
(calc-extensions) |
(calc-extensions) |
3038 |
(let ((calc-line-breaking nil)) |
(let ((calc-line-breaking nil)) |
3039 |
(math-composition-to-string (math-compose-expr a 0) w))) |
(math-composition-to-string (math-compose-expr a 0) w)))) |
|
) |
|
3040 |
|
|
3041 |
(defun calc-window-width () |
(defun calc-window-width () |
3042 |
(if calc-embedded-info |
(if calc-embedded-info |
3043 |
(let ((win (get-buffer-window (aref calc-embedded-info 0)))) |
(let ((win (get-buffer-window (aref calc-embedded-info 0)))) |
3044 |
(1- (if win (window-width win) (frame-width)))) |
(1- (if win (window-width win) (frame-width)))) |
3045 |
(- (window-width (get-buffer-window (current-buffer))) |
(- (window-width (get-buffer-window (current-buffer))) |
3046 |
(if calc-line-numbering 5 1))) |
(if calc-line-numbering 5 1)))) |
|
) |
|
3047 |
|
|
3048 |
(defun math-comp-concat (c1 c2) |
(defun math-comp-concat (c1 c2) |
3049 |
(if (and (stringp c1) (stringp c2)) |
(if (and (stringp c1) (stringp c2)) |
3050 |
(concat c1 c2) |
(concat c1 c2) |
3051 |
(list 'horiz c1 c2)) |
(list 'horiz c1 c2))) |
|
) |
|
3052 |
|
|
3053 |
|
|
3054 |
|
|
3071 |
(math-format-number a))) |
(math-format-number a))) |
3072 |
(t |
(t |
3073 |
(calc-extensions) |
(calc-extensions) |
3074 |
(math-format-flat-expr-fancy a prec))) |
(math-format-flat-expr-fancy a prec)))) |
|
) |
|
3075 |
|
|
3076 |
|
|
3077 |
|
|
3181 |
str))) |
str))) |
3182 |
(t |
(t |
3183 |
(calc-extensions) |
(calc-extensions) |
3184 |
(math-format-number-fancy a prec))) |
(math-format-number-fancy a prec)))) |
|
) |
|
3185 |
|
|
3186 |
(defun math-format-bignum (a) ; [X L] |
(defun math-format-bignum (a) ; [X L] |
3187 |
(if (and (= calc-number-radix 10) |
(if (and (= calc-number-radix 10) |
3189 |
(not calc-group-digits)) |
(not calc-group-digits)) |
3190 |
(math-format-bignum-decimal a) |
(math-format-bignum-decimal a) |
3191 |
(calc-extensions) |
(calc-extensions) |
3192 |
(math-format-bignum-fancy a)) |
(math-format-bignum-fancy a))) |
|
) |
|
3193 |
|
|
3194 |
(defun math-format-bignum-decimal (a) ; [X L] |
(defun math-format-bignum-decimal (a) ; [X L] |
3195 |
(if a |
(if a |
3198 |
(setq s (concat (format "%06d" (+ (* (nth 1 a) 1000) (car a))) s) |
(setq s (concat (format "%06d" (+ (* (nth 1 a) 1000) (car a))) s) |
3199 |
a (cdr (cdr a)))) |
a (cdr (cdr a)))) |
3200 |
(concat (int-to-string (+ (* (or (nth 1 a) 0) 1000) (car a))) s)) |
(concat (int-to-string (+ (* (or (nth 1 a) 0) 1000) (car a))) s)) |
3201 |
"0") |
"0")) |
|
) |
|
3202 |
|
|
3203 |
|
|
3204 |
|
|
3258 |
(list 'float (nth 1 mant) (+ (nth 2 mant) exp))))))) |
(list 'float (nth 1 mant) (+ (nth 2 mant) exp))))))) |
3259 |
|
|
3260 |
;; Syntax error! |
;; Syntax error! |
3261 |
(t nil))) |
(t nil)))) |
|
) |
|
3262 |
|
|
3263 |
(defun math-match-substring (s n) |
(defun math-match-substring (s n) |
3264 |
(if (match-beginning n) |
(if (match-beginning n) |
3265 |
(substring s (match-beginning n) (match-end n)) |
(substring s (match-beginning n) (match-end n)) |
3266 |
"") |
"")) |
|
) |
|
3267 |
|
|
3268 |
(defun math-read-bignum (s) ; [l X] |
(defun math-read-bignum (s) ; [l X] |
3269 |
(if (> (length s) 3) |
(if (> (length s) 3) |
3270 |
(cons (string-to-int (substring s -3)) |
(cons (string-to-int (substring s -3)) |
3271 |
(math-read-bignum (substring s 0 -3))) |
(math-read-bignum (substring s 0 -3))) |
3272 |
(list (string-to-int s))) |
(list (string-to-int s)))) |
|
) |
|
3273 |
|
|
3274 |
|
|
3275 |
(defconst math-tex-ignore-words |
(defconst math-tex-ignore-words |
3342 |
"Parse the region as a vector of numbers and push it on the Calculator stack." |
"Parse the region as a vector of numbers and push it on the Calculator stack." |
3343 |
(interactive "r\nP") |
(interactive "r\nP") |
3344 |
(calc-extensions) |
(calc-extensions) |
3345 |
(calc-do-grab-region top bot arg) |
(calc-do-grab-region top bot arg)) |
|
) |
|
3346 |
|
|
3347 |
;;;###autoload |
;;;###autoload |
3348 |
(defun calc-grab-rectangle (top bot arg) |
(defun calc-grab-rectangle (top bot arg) |
3349 |
"Parse a rectangle as a matrix of numbers and push it on the Calculator stack." |
"Parse a rectangle as a matrix of numbers and push it on the Calculator stack." |
3350 |
(interactive "r\nP") |
(interactive "r\nP") |
3351 |
(calc-extensions) |
(calc-extensions) |
3352 |
(calc-do-grab-rectangle top bot arg) |
(calc-do-grab-rectangle top bot arg)) |
|
) |
|
3353 |
|
|
3354 |
(defun calc-grab-sum-down (top bot arg) |
(defun calc-grab-sum-down (top bot arg) |
3355 |
"Parse a rectangle as a matrix of numbers and sum its columns." |
"Parse a rectangle as a matrix of numbers and sum its columns." |
3356 |
(interactive "r\nP") |
(interactive "r\nP") |
3357 |
(calc-extensions) |
(calc-extensions) |
3358 |
(calc-do-grab-rectangle top bot arg 'calcFunc-reduced) |
(calc-do-grab-rectangle top bot arg 'calcFunc-reduced)) |
|
) |
|
3359 |
|
|
3360 |
(defun calc-grab-sum-across (top bot arg) |
(defun calc-grab-sum-across (top bot arg) |
3361 |
"Parse a rectangle as a matrix of numbers and sum its rows." |
"Parse a rectangle as a matrix of numbers and sum its rows." |
3362 |
(interactive "r\nP") |
(interactive "r\nP") |
3363 |
(calc-extensions) |
(calc-extensions) |
3364 |
(calc-do-grab-rectangle top bot arg 'calcFunc-reducea) |
(calc-do-grab-rectangle top bot arg 'calcFunc-reducea)) |
|
) |
|
3365 |
|
|
3366 |
|
|
3367 |
;;;###autoload |
;;;###autoload |
3369 |
"Start Calc Embedded mode on the formula surrounding point." |
"Start Calc Embedded mode on the formula surrounding point." |
3370 |
(interactive "P") |
(interactive "P") |
3371 |
(calc-extensions) |
(calc-extensions) |
3372 |
(calc-do-embedded arg end obeg oend) |
(calc-do-embedded arg end obeg oend)) |
|
) |
|
3373 |
|
|
3374 |
;;;###autoload |
;;;###autoload |
3375 |
(defun calc-embedded-activate (&optional arg cbuf) |
(defun calc-embedded-activate (&optional arg cbuf) |
3376 |
"Scan the current editing buffer for all embedded := and => formulas. |
"Scan the current editing buffer for all embedded := and => formulas. |
3377 |
Also looks for the equivalent TeX words, \\gets and \\evalto." |
Also looks for the equivalent TeX words, \\gets and \\evalto." |
3378 |
(interactive "P") |
(interactive "P") |
3379 |
(calc-do-embedded-activate arg cbuf) |
(calc-do-embedded-activate arg cbuf)) |
|
) |
|
3380 |
|
|
3381 |
|
|
3382 |
(defun calc-user-invocation () |
(defun calc-user-invocation () |
3383 |
(interactive) |
(interactive) |
3384 |
(or (stringp calc-invocation-macro) |
(or (stringp calc-invocation-macro) |
3385 |
(error "Use `Z I' inside Calc to define a `M-# Z' keyboard macro")) |
(error "Use `Z I' inside Calc to define a `M-# Z' keyboard macro")) |
3386 |
(execute-kbd-macro calc-invocation-macro nil) |
(execute-kbd-macro calc-invocation-macro nil)) |
|
) |
|
3387 |
|
|
3388 |
|
|
3389 |
|
|
3393 |
;;;###autoload |
;;;###autoload |
3394 |
(defmacro defmath (func args &rest body) ; [Public] |
(defmacro defmath (func args &rest body) ; [Public] |
3395 |
(calc-extensions) |
(calc-extensions) |
3396 |
(math-do-defmath func args body) |
(math-do-defmath func args body)) |
|
) |
|
3397 |
|
|
3398 |
|
|
3399 |
;;; Functions needed for Lucid Emacs support. |
;;; Functions needed for Lucid Emacs support. |
3409 |
(cons key key))) |
(cons key key))) |
3410 |
(t |
(t |
3411 |
(let ((key (read-char))) |
(let ((key (read-char))) |
3412 |
(cons key key)))) |
(cons key key))))) |
|
) |
|
3413 |
|
|
3414 |
(defun calc-unread-command (&optional input) |
(defun calc-unread-command (&optional input) |
3415 |
(if (featurep 'xemacs) |
(if (featurep 'xemacs) |
3426 |
(if calc-always-load-extensions |
(if calc-always-load-extensions |
3427 |
(progn |
(progn |
3428 |
(calc-extensions) |
(calc-extensions) |
3429 |
(calc-load-everything)) |
(calc-load-everything))) |
|
) |
|
3430 |
|
|
3431 |
|
|
3432 |
(run-hooks 'calc-load-hook) |
(run-hooks 'calc-load-hook) |
3433 |
|
|
3434 |
|
;;; calc.el ends here |