/[emacs]/emacs/lisp/calc/calc.el
ViewVC logotype

Diff of /emacs/lisp/calc/calc.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by eliz, Tue Nov 13 07:31:54 2001 UTC revision 1.4 by walters, Wed Nov 14 09:08:39 2001 UTC
# Line 922  calc-shift-Y-prefix-help calc-tutorial c Line 922  calc-shift-Y-prefix-help calc-tutorial c
922  report-calc-bug)  report-calc-bug)
923    
924  ))  ))
   
925  )  )
926    
927  (calc-init-base)  (calc-init-base)
# Line 947  report-calc-bug) Line 946  report-calc-bug)
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
# Line 963  report-calc-bug) Line 961  report-calc-bug)
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)
# Line 984  report-calc-bug) Line 981  report-calc-bug)
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    
# Line 1065  Notations:  3.14e6     3.14 * 10^6 Line 1061  Notations:  3.14e6     3.14 * 10^6
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)
# Line 1084  Notations:  3.14e6     3.14 * 10^6 Line 1079  Notations:  3.14e6     3.14 * 10^6
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)
# Line 1115  commands given here will actually operat Line 1109  commands given here will actually operat
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*"))
# Line 1128  commands given here will actually operat Line 1121  commands given here will actually operat
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)
# Line 1191  commands given here will actually operat Line 1183  commands given here will actually operat
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)."
# Line 1213  commands given here will actually operat Line 1203  commands given here will actually operat
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)
# Line 1253  commands given here will actually operat Line 1242  commands given here will actually operat
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 ()
# Line 1279  In this mode, click on the Calc \"button Line 1265  In this mode, click on the Calc \"button
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 ()
# Line 1288  Or, position the cursor manually and do Line 1273  Or, position the cursor manually and do
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.
# Line 1367  See calc-keypad for details." Line 1351  See calc-keypad for details."
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)
# Line 1384  See calc-keypad for details." Line 1367  See calc-keypad for details."
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)
# Line 1404  See calc-keypad for details." Line 1384  See calc-keypad for details."
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
# Line 1510  See calc-keypad for details." Line 1489  See calc-keypad for details."
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)
# Line 1527  See calc-keypad for details." Line 1505  See calc-keypad for details."
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
# Line 1556  See calc-keypad for details." Line 1532  See calc-keypad for details."
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)
# Line 1577  See calc-keypad for details." Line 1551  See calc-keypad for details."
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)
# Line 1594  See calc-keypad for details." Line 1567  See calc-keypad for details."
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.
# Line 1635  See calc-keypad for details." Line 1605  See calc-keypad for details."
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)
# Line 1649  See calc-keypad for details." Line 1618  See calc-keypad for details."
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))
# Line 1671  See calc-keypad for details." Line 1637  See calc-keypad for details."
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 ()
# Line 1709  See calc-keypad for details." Line 1673  See calc-keypad for details."
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)
# Line 1743  See calc-keypad for details." Line 1706  See calc-keypad for details."
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)
# Line 1763  If mouse is pressed in Calc window, push Line 1725  If mouse is pressed in Calc window, push
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    
# Line 1774  If mouse is pressed in Calc window, push Line 1735  If mouse is pressed in Calc window, push
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)
# Line 1794  If mouse is pressed in Calc window, push Line 1754  If mouse is pressed in Calc window, push
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)
# Line 1825  If mouse is pressed in Calc window, push Line 1784  If mouse is pressed in Calc window, push
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)
# Line 1855  If mouse is pressed in Calc window, push Line 1813  If mouse is pressed in Calc window, push
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)
# Line 1886  If mouse is pressed in Calc window, push Line 1843  If mouse is pressed in Calc window, push
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    
# Line 1901  If mouse is pressed in Calc window, push Line 1857  If mouse is pressed in Calc window, push
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    
# Line 1916  If mouse is pressed in Calc window, push Line 1871  If mouse is pressed in Calc window, push
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)
# Line 1925  If mouse is pressed in Calc window, push Line 1879  If mouse is pressed in Calc window, push
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    
# Line 1972  If mouse is pressed in Calc window, push Line 1920  If mouse is pressed in Calc window, push
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)
# Line 1999  If mouse is pressed in Calc window, push Line 1946  If mouse is pressed in Calc window, push
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    
# Line 2042  If mouse is pressed in Calc window, push Line 1988  If mouse is pressed in Calc window, push
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)))
# Line 2067  If mouse is pressed in Calc window, push Line 2012  If mouse is pressed in Calc window, push
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)
# Line 2174  If mouse is pressed in Calc window, push Line 2117  If mouse is pressed in Calc window, push
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 ()
# Line 2193  If mouse is pressed in Calc window, push Line 2135  If mouse is pressed in Calc window, push
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    
# Line 2401  If mouse is pressed in Calc window, push Line 2342  If mouse is pressed in Calc window, push
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    
# Line 2414  If mouse is pressed in Calc window, push Line 2354  If mouse is pressed in Calc window, push
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    
# Line 2425  If mouse is pressed in Calc window, push Line 2364  If mouse is pressed in Calc window, push
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    
# Line 2434  If mouse is pressed in Calc window, push Line 2372  If mouse is pressed in Calc window, push
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]
# Line 2472  If mouse is pressed in Calc window, push Line 2408  If mouse is pressed in Calc window, push
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)
# Line 2489  If mouse is pressed in Calc window, push Line 2423  If mouse is pressed in Calc window, push
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)
# Line 2501  If mouse is pressed in Calc window, push Line 2434  If mouse is pressed in Calc window, push
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]
# Line 2519  If mouse is pressed in Calc window, push Line 2451  If mouse is pressed in Calc window, push
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)
# Line 2544  If mouse is pressed in Calc window, push Line 2474  If mouse is pressed in Calc window, push
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)
# Line 2553  If mouse is pressed in Calc window, push Line 2482  If mouse is pressed in Calc window, push
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)
# Line 2572  If mouse is pressed in Calc window, push Line 2500  If mouse is pressed in Calc window, push
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)
# Line 2581  If mouse is pressed in Calc window, push Line 2508  If mouse is pressed in Calc window, push
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)
# Line 2610  If mouse is pressed in Calc window, push Line 2536  If mouse is pressed in Calc window, push
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]
# Line 2661  If mouse is pressed in Calc window, push Line 2586  If mouse is pressed in Calc window, push
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
# Line 2696  If mouse is pressed in Calc window, push Line 2620  If mouse is pressed in Calc window, push
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
# Line 2735  If mouse is pressed in Calc window, push Line 2658  If mouse is pressed in Calc window, push
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))))
# Line 2753  If mouse is pressed in Calc window, push Line 2675  If mouse is pressed in Calc window, push
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)
# Line 2763  If mouse is pressed in Calc window, push Line 2684  If mouse is pressed in Calc window, push
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))))
# Line 2782  If mouse is pressed in Calc window, push Line 2702  If mouse is pressed in Calc window, push
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]
# Line 2829  If mouse is pressed in Calc window, push Line 2748  If mouse is pressed in Calc window, push
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)))
# Line 2842  If mouse is pressed in Calc window, push Line 2760  If mouse is pressed in Calc window, push
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)
# Line 2869  If mouse is pressed in Calc window, push Line 2786  If mouse is pressed in Calc window, push
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)
# Line 2887  If mouse is pressed in Calc window, push Line 2803  If mouse is pressed in Calc window, push
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
# Line 2910  If mouse is pressed in Calc window, push Line 2825  If mouse is pressed in Calc window, push
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)))
# Line 2932  If mouse is pressed in Calc window, push Line 2846  If mouse is pressed in Calc window, push
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]
# Line 2951  If mouse is pressed in Calc window, push Line 2864  If mouse is pressed in Calc window, push
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)
# Line 2962  If mouse is pressed in Calc window, push Line 2874  If mouse is pressed in Calc window, push
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)
# Line 2973  If mouse is pressed in Calc window, push Line 2884  If mouse is pressed in Calc window, push
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]
# Line 3027  If mouse is pressed in Calc window, push Line 2935  If mouse is pressed in Calc window, push
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    
# Line 3100  If mouse is pressed in Calc window, push Line 3006  If mouse is pressed in Calc window, push
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))
# Line 3115  If mouse is pressed in Calc window, push Line 3020  If mouse is pressed in Calc window, push
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)
# Line 3124  If mouse is pressed in Calc window, push Line 3028  If mouse is pressed in Calc window, push
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)
# Line 3133  If mouse is pressed in Calc window, push Line 3036  If mouse is pressed in Calc window, push
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    
# Line 3171  If mouse is pressed in Calc window, push Line 3071  If mouse is pressed in Calc window, push
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    
# Line 3282  If mouse is pressed in Calc window, push Line 3181  If mouse is pressed in Calc window, push
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)
# Line 3291  If mouse is pressed in Calc window, push Line 3189  If mouse is pressed in Calc window, push
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
# Line 3301  If mouse is pressed in Calc window, push Line 3198  If mouse is pressed in Calc window, push
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    
# Line 3362  If mouse is pressed in Calc window, push Line 3258  If mouse is pressed in Calc window, push
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
# Line 3449  If mouse is pressed in Calc window, push Line 3342  If mouse is pressed in Calc window, push
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
# Line 3480  If mouse is pressed in Calc window, push Line 3369  If mouse is pressed in Calc window, push
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    
# Line 3507  Also looks for the equivalent TeX words, Line 3393  Also looks for the equivalent TeX words,
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.
# Line 3524  Also looks for the equivalent TeX words, Line 3409  Also looks for the equivalent TeX words,
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)
# Line 3542  Also looks for the equivalent TeX words, Line 3426  Also looks for the equivalent TeX words,
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

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26