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

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

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

revision 1.3 by eliz, Mon Nov 12 11:40:54 2001 UTC revision 1.4 by walters, Wed Nov 14 09:03:32 2001 UTC
# Line 1  Line 1 
1  ;; Calculator for GNU Emacs, part II  ;; Calculator for GNU Emacs, part II
2  ;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc.  ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
3  ;; Written by Dave Gillespie, daveg@synaptics.com.  ;; Written by Dave Gillespie, daveg@synaptics.com.
4    
5  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
# Line 30  Line 30 
30  ;;;###autoload  ;;;###autoload
31  (defun calc-extensions ()  (defun calc-extensions ()
32    "This function is part of the autoload linkage for parts of Calc."    "This function is part of the autoload linkage for parts of Calc."
33    t    t)
 )  
34    
35  ;;; Auto-load calc.el part, in case this part was loaded first.  ;;; Auto-load calc.el part, in case this part was loaded first.
36  (if (fboundp 'calc-dispatch)  (if (fboundp 'calc-dispatch)
# Line 1133  calc-copy-to-buffer calc-edit calc-edit- Line 1132  calc-copy-to-buffer calc-edit calc-edit-
1132  calc-kill calc-kill-region calc-yank)  calc-kill calc-kill-region calc-yank)
1133    
1134  ))  ))
   
1135  )  )
1136    
1137  (defun calc-init-prefixes ()  (defun calc-init-prefixes ()
# Line 1162  calc-kill calc-kill-region calc-yank) Line 1160  calc-kill calc-kill-region calc-yank)
1160      (define-key calc-mode-map "M" 'calc-more-recursion-depth)      (define-key calc-mode-map "M" 'calc-more-recursion-depth)
1161      (define-key calc-mode-map "S" 'calc-sin)      (define-key calc-mode-map "S" 'calc-sin)
1162      (define-key calc-mode-map "T" 'calc-tan)      (define-key calc-mode-map "T" 'calc-tan)
1163      (define-key calc-mode-map "U" 'calc-undo))      (define-key calc-mode-map "U" 'calc-undo)))
 )  
1164    
1165  (calc-init-extensions)  (calc-init-extensions)
1166    
# Line 1173  calc-kill calc-kill-region calc-yank) Line 1170  calc-kill calc-kill-region calc-yank)
1170  ;;;; Miscellaneous.  ;;;; Miscellaneous.
1171    
1172  (defun calc-clear-command-flag (f)  (defun calc-clear-command-flag (f)
1173    (setq calc-command-flags (delq f calc-command-flags))    (setq calc-command-flags (delq f calc-command-flags)))
 )  
1174    
1175    
1176  (defun calc-record-message (tag &rest args)  (defun calc-record-message (tag &rest args)
1177    (let ((msg (apply 'format args)))    (let ((msg (apply 'format args)))
1178      (message "%s" msg)      (message "%s" msg)
1179      (calc-record msg tag))      (calc-record msg tag))
1180    (calc-clear-command-flag 'clear-message)    (calc-clear-command-flag 'clear-message))
 )  
1181    
1182    
1183  (defun calc-normalize-fancy (val)  (defun calc-normalize-fancy (val)
# Line 1201  calc-kill calc-kill-region calc-yank) Line 1196  calc-kill calc-kill-region calc-yank)
1196            ((eq simp 'units)            ((eq simp 'units)
1197             (math-simplify-units val))             (math-simplify-units val))
1198            (t  ; nil, none, num            (t  ; nil, none, num
1199             (math-normalize val))))             (math-normalize val)))))
 )  
1200    
1201    
1202    
# Line 1224  calc-kill calc-kill-region calc-yank) Line 1218  calc-kill calc-kill-region calc-yank)
1218    (define-key calc-help-map "\C-n" 'calc-view-news)    (define-key calc-help-map "\C-n" 'calc-view-news)
1219    (define-key calc-help-map "\C-w" 'calc-describe-no-warranty)    (define-key calc-help-map "\C-w" 'calc-describe-no-warranty)
1220    (define-key calc-help-map "?" 'calc-help-for-help)    (define-key calc-help-map "?" 'calc-help-for-help)
1221    (define-key calc-help-map "\C-h" 'calc-help-for-help)    (define-key calc-help-map "\C-h" 'calc-help-for-help))
 )  
1222    
1223    
1224  (defun calc-do-prefix-help (msgs group key)  (defun calc-do-prefix-help (msgs group key)
# Line 1255  calc-kill calc-kill-region calc-yank) Line 1248  calc-kill calc-kill-region calc-yank)
1248                (message "%s: %s: %c-" group (car msgs) key)                (message "%s: %s: %c-" group (car msgs) key)
1249              (message "%s: (none)  %c-" group (car msgs) key))              (message "%s: (none)  %c-" group (car msgs) key))
1250          (message "%s: %s" group (car msgs))))          (message "%s: %s" group (car msgs))))
1251      (and key (calc-unread-command key)))      (and key (calc-unread-command key))))
 )  
1252  (defvar calc-prefix-help-phase 0)  (defvar calc-prefix-help-phase 0)
1253    
1254    
# Line 1299  calc-kill calc-kill-region calc-yank) Line 1291  calc-kill calc-kill-region calc-yank)
1291                   (select-window win)                   (select-window win)
1292                   (enlarge-window (- calc-window-height height))                   (enlarge-window (- calc-window-height height))
1293                   (select-window swin)))))))                   (select-window swin)))))))
1294    (message "(Calculator reset)")    (message "(Calculator reset)"))
 )  
1295    
1296    
1297  (defun calc-scroll-left (n)  (defun calc-scroll-left (n)
1298    (interactive "P")    (interactive "P")
1299    (scroll-left (or n (/ (window-width) 2)))    (scroll-left (or n (/ (window-width) 2))))
 )  
1300    
1301  (defun calc-scroll-right (n)  (defun calc-scroll-right (n)
1302    (interactive "P")    (interactive "P")
1303    (scroll-right (or n (/ (window-width) 2)))    (scroll-right (or n (/ (window-width) 2))))
 )  
1304    
1305  (defun calc-scroll-up (n)  (defun calc-scroll-up (n)
1306    (interactive "P")    (interactive "P")
# Line 1326  calc-kill calc-kill-region calc-yank) Line 1315  calc-kill calc-kill-region calc-yank)
1315                            (save-excursion                            (save-excursion
1316                              (forward-line (- (1- (window-height))))                              (forward-line (- (1- (window-height))))
1317                              (point)))                              (point)))
1318          (forward-line -1)))          (forward-line -1))))
 )  
1319    
1320  (defun calc-scroll-down (n)  (defun calc-scroll-down (n)
1321    (interactive "P")    (interactive "P")
1322    (or (pos-visible-in-window-p 1)    (or (pos-visible-in-window-p 1)
1323        (scroll-down (or n (/ (window-height) 2))))        (scroll-down (or n (/ (window-height) 2)))))
 )  
1324    
1325    
1326  (defun calc-precision (n)  (defun calc-precision (n)
# Line 1346  calc-kill calc-kill-region calc-yank) Line 1333  calc-kill calc-kill-region calc-yank)
1333                              (< (nth 1 calc-float-format)                              (< (nth 1 calc-float-format)
1334                                  (if (= calc-number-radix 10) 0 1))))                                  (if (= calc-number-radix 10) 0 1))))
1335       (calc-record calc-internal-prec "prec"))       (calc-record calc-internal-prec "prec"))
1336     (message "Floating-point precision is %d digits." calc-internal-prec))     (message "Floating-point precision is %d digits." calc-internal-prec)))
 )  
1337    
1338    
1339  (defun calc-inverse (&optional n)  (defun calc-inverse (&optional n)
1340    (interactive "P")    (interactive "P")
1341    (calc-fancy-prefix 'calc-inverse-flag "Inverse..." n)    (calc-fancy-prefix 'calc-inverse-flag "Inverse..." n))
 )  
1342    
1343  (defconst calc-fancy-prefix-map  (defconst calc-fancy-prefix-map
1344    (let ((map (make-sparse-keymap)))    (let ((map (make-sparse-keymap)))
# Line 1415  calc-kill calc-kill-region calc-yank) Line 1400  calc-kill calc-kill-region calc-yank)
1400      (calc-select-buffer)      (calc-select-buffer)
1401      (setq calc-inverse-flag (not (calc-is-inverse))      (setq calc-inverse-flag (not (calc-is-inverse))
1402            calc-hyperbolic-flag (calc-is-hyperbolic)            calc-hyperbolic-flag (calc-is-hyperbolic)
1403            current-prefix-arg nil))            current-prefix-arg nil)))
 )  
1404    
1405  (defun calc-is-inverse ()  (defun calc-is-inverse ()
1406    calc-inverse-flag    calc-inverse-flag)
 )  
1407    
1408  (defun calc-hyperbolic (&optional n)  (defun calc-hyperbolic (&optional n)
1409    (interactive "P")    (interactive "P")
1410    (calc-fancy-prefix 'calc-hyperbolic-flag "Hyperbolic..." n)    (calc-fancy-prefix 'calc-hyperbolic-flag "Hyperbolic..." n))
 )  
1411    
1412  (defun calc-hyperbolic-func ()  (defun calc-hyperbolic-func ()
1413    (save-excursion    (save-excursion
1414      (calc-select-buffer)      (calc-select-buffer)
1415      (setq calc-inverse-flag (calc-is-inverse)      (setq calc-inverse-flag (calc-is-inverse)
1416            calc-hyperbolic-flag (not (calc-is-hyperbolic))            calc-hyperbolic-flag (not (calc-is-hyperbolic))
1417            current-prefix-arg nil))            current-prefix-arg nil)))
 )  
1418    
1419  (defun calc-is-hyperbolic ()  (defun calc-is-hyperbolic ()
1420    calc-hyperbolic-flag    calc-hyperbolic-flag)
 )  
1421    
1422  (defun calc-keep-args (&optional n)  (defun calc-keep-args (&optional n)
1423    (interactive "P")    (interactive "P")
1424    (calc-fancy-prefix 'calc-keep-args-flag "Keep args..." n)    (calc-fancy-prefix 'calc-keep-args-flag "Keep args..." n))
 )  
1425    
1426    
1427  (defun calc-change-mode (var value &optional refresh option)  (defun calc-change-mode (var value &optional refresh option)
# Line 1496  calc-kill calc-kill-region calc-yank) Line 1475  calc-kill calc-kill-region calc-yank)
1475                   (not (equal var '(calc-mode-save-mode)))                   (not (equal var '(calc-mode-save-mode)))
1476                   (calc-save-modes t))))                   (calc-save-modes t))))
1477        (if calc-embedded-info (calc-embedded-modes-change var))        (if calc-embedded-info (calc-embedded-modes-change var))
1478        (symbol-value (car var))))        (symbol-value (car var)))))
 )  
1479    
1480  (defun calc-refresh-top (n)  (defun calc-refresh-top (n)
1481    (interactive "p")    (interactive "p")
# Line 1517  calc-kill calc-kill-region calc-yank) Line 1495  calc-kill calc-kill-region calc-yank)
1495              (calc-push-list (mapcar 'car entries)              (calc-push-list (mapcar 'car entries)
1496                              1                              1
1497                              (mapcar (function (lambda (x) (nth 2 x)))                              (mapcar (function (lambda (x) (nth 2 x)))
1498                                      entries))))))                                      entries)))))))
 )  
1499    
1500  (defun calc-refresh-evaltos (&optional which-var)  (defun calc-refresh-evaltos (&optional which-var)
1501    (and calc-any-evaltos calc-auto-recompute (not calc-no-refresh-evaltos)    (and calc-any-evaltos calc-auto-recompute (not calc-no-refresh-evaltos)
# Line 1541  calc-kill calc-kill-region calc-yank) Line 1518  calc-kill calc-kill-region calc-yank)
1518                         (calc-pop-stack 1 (1+ num) t)))))                         (calc-pop-stack 1 (1+ num) t)))))
1519             (setq num (1- num)))))             (setq num (1- num)))))
1520    (and calc-embedded-active which-var    (and calc-embedded-active which-var
1521         (calc-embedded-var-change which-var))         (calc-embedded-var-change which-var)))
 )  
1522  (setq calc-refreshing-evaltos nil)  (setq calc-refreshing-evaltos nil)
1523  (setq calc-no-refresh-evaltos nil)  (setq calc-no-refresh-evaltos nil)
1524    
1525    
1526  (defun calc-push (&rest vals)  (defun calc-push (&rest vals)
1527    (calc-push-list vals)    (calc-push-list vals))
 )  
1528    
1529  (defun calc-pop-push (n &rest vals)  (defun calc-pop-push (n &rest vals)
1530    (calc-pop-push-list n vals)    (calc-pop-push-list n vals))
 )  
1531    
1532  (defun calc-pop-push-record (n prefix &rest vals)  (defun calc-pop-push-record (n prefix &rest vals)
1533    (calc-pop-push-record-list n prefix vals)    (calc-pop-push-record-list n prefix vals))
 )  
1534    
1535    
1536  (defun calc-evaluate (n)  (defun calc-evaluate (n)
# Line 1572  calc-kill calc-kill-region calc-yank) Line 1545  calc-kill calc-kill-region calc-yank)
1545                                     (- n))                                     (- n))
1546        (calc-pop-push-record-list n "eval" (mapcar 'math-evaluate-expr        (calc-pop-push-record-list n "eval" (mapcar 'math-evaluate-expr
1547                                                    (calc-top-list n)))))                                                    (calc-top-list n)))))
1548     (calc-handle-whys))     (calc-handle-whys)))
 )  
1549    
1550    
1551  (defun calc-eval-num (n)  (defun calc-eval-num (n)
# Line 1587  calc-kill calc-kill-region calc-yank) Line 1559  calc-kill calc-kill-region calc-yank)
1559            (calc-symbolic-mode nil))            (calc-symbolic-mode nil))
1560       (calc-with-default-simplification       (calc-with-default-simplification
1561        (calc-pop-push-record 1 "num" (math-evaluate-expr (calc-top 1)))))        (calc-pop-push-record 1 "num" (math-evaluate-expr (calc-top 1)))))
1562     (calc-handle-whys))     (calc-handle-whys)))
 )  
1563    
1564    
1565  (defun calc-execute-extended-command (n)  (defun calc-execute-extended-command (n)
# Line 1596  calc-kill calc-kill-region calc-yank) Line 1567  calc-kill calc-kill-region calc-yank)
1567    (let* ((prompt (concat (calc-num-prefix-name n) "M-x "))    (let* ((prompt (concat (calc-num-prefix-name n) "M-x "))
1568           (cmd (intern (completing-read prompt obarray 'commandp t "calc-"))))           (cmd (intern (completing-read prompt obarray 'commandp t "calc-"))))
1569      (setq prefix-arg n)      (setq prefix-arg n)
1570      (command-execute cmd))      (command-execute cmd)))
 )  
1571    
1572    
1573  (defun calc-realign (&optional num)  (defun calc-realign (&optional num)
# Line 1617  calc-kill calc-kill-region calc-yank) Line 1587  calc-kill calc-kill-region calc-yank)
1587                (forward-line 1)))                (forward-line 1)))
1588        (calc-wrapper        (calc-wrapper
1589         (if (get-buffer-window (current-buffer))         (if (get-buffer-window (current-buffer))
1590             (set-window-hscroll (get-buffer-window (current-buffer)) 0)))))             (set-window-hscroll (get-buffer-window (current-buffer)) 0))))))
 )  
1591    
1592    
1593    
# Line 1638  calc-kill calc-kill-region calc-yank) Line 1607  calc-kill calc-kill-region calc-yank)
1607                 (if (eq (car-safe val) 'error)                 (if (eq (car-safe val) 'error)
1608                     (error "Bad format in variable contents: %s" (nth 2 val))                     (error "Bad format in variable contents: %s" (nth 2 val))
1609                   (set v val)))                   (set v val)))
1610             (symbol-value v))))             (symbol-value v)))))
 )  
1611    
1612    
1613    
# Line 1683  calc-kill calc-kill-region calc-yank) Line 1651  calc-kill calc-kill-region calc-yank)
1651    (calc-slow-wrapper    (calc-slow-wrapper
1652     (calc-unary-op "flt"     (calc-unary-op "flt"
1653                    (if (calc-is-hyperbolic) 'calcFunc-float 'calcFunc-pfloat)                    (if (calc-is-hyperbolic) 'calcFunc-float 'calcFunc-pfloat)
1654                    arg))                    arg)))
 )  
1655    
1656    
1657  (defvar calc-gnuplot-process nil)  (defvar calc-gnuplot-process nil)
# Line 1696  calc-kill calc-kill-region calc-yank) Line 1663  calc-kill calc-kill-region calc-yank)
1663         (buffer-name calc-gnuplot-buffer)         (buffer-name calc-gnuplot-buffer)
1664         calc-gnuplot-input         calc-gnuplot-input
1665         (buffer-name calc-gnuplot-input)         (buffer-name calc-gnuplot-input)
1666         (memq (process-status calc-gnuplot-process) '(run stop)))         (memq (process-status calc-gnuplot-process) '(run stop))))
 )  
1667    
1668    
1669    
# Line 1747  calc-kill calc-kill-region calc-yank) Line 1713  calc-kill calc-kill-region calc-yank)
1713    (calc-Need-calc-vec)    (calc-Need-calc-vec)
1714    (calc-Need-calc-yank)    (calc-Need-calc-yank)
1715    
1716    (message "All parts of Calc are now loaded.")    (message "All parts of Calc are now loaded."))
 )  
1717    
1718    
1719  ;;; Vector commands.  ;;; Vector commands.
# Line 1764  calc-kill calc-kill-region calc-yank) Line 1729  calc-kill calc-kill-region calc-yank)
1729                                          (calc-top 1) (calc-top 2))))                                          (calc-top 1) (calc-top 2))))
1730       (if (calc-is-hyperbolic)       (if (calc-is-hyperbolic)
1731           (calc-binary-op "apnd" 'calcFunc-append arg '(vec))           (calc-binary-op "apnd" 'calcFunc-append arg '(vec))
1732         (calc-binary-op "|" 'calcFunc-vconcat arg '(vec) nil '|))))         (calc-binary-op "|" 'calcFunc-vconcat arg '(vec) nil '|)))))
 )  
1733    
1734  (defun calc-append (arg)  (defun calc-append (arg)
1735    (interactive "P")    (interactive "P")
1736    (calc-hyperbolic-func)    (calc-hyperbolic-func)
1737    (calc-concat arg)    (calc-concat arg))
 )  
1738    
1739    
1740  (defconst calc-arg-values '( ( var ArgA var-ArgA ) ( var ArgB var-ArgB )  (defconst calc-arg-values '( ( var ArgA var-ArgA ) ( var ArgB var-ArgB )
# Line 1782  calc-kill calc-kill-region calc-yank) Line 1745  calc-kill calc-kill-region calc-yank)
1745  ))  ))
1746    
1747  (defun calc-invent-args (n)  (defun calc-invent-args (n)
1748    (nreverse (nthcdr (- (length calc-arg-values) n) (reverse calc-arg-values)))    (nreverse (nthcdr (- (length calc-arg-values) n) (reverse calc-arg-values))))
 )  
1749    
1750    
1751    
# Line 1796  calc-kill calc-kill-region calc-yank) Line 1758  calc-kill calc-kill-region calc-yank)
1758    (let ((res (cdr (lookup-key calc-mode-map "z"))))    (let ((res (cdr (lookup-key calc-mode-map "z"))))
1759      (if (eq (car (car res)) 27)      (if (eq (car (car res)) 27)
1760          (cdr res)          (cdr res)
1761        res))        res)))
 )  
1762    
1763  (defun calc-z-prefix-help ()  (defun calc-z-prefix-help ()
1764    (interactive)    (interactive)
# Line 1818  calc-kill calc-kill-region calc-yank) Line 1779  calc-kill calc-kill-region calc-yank)
1779        (calc-user-function-list kmap 6))        (calc-user-function-list kmap 6))
1780      (if (/= flags 0)      (if (/= flags 0)
1781          (setq msgs (cons buf msgs)))          (setq msgs (cons buf msgs)))
1782      (calc-do-prefix-help (nreverse msgs) "user" ?z))      (calc-do-prefix-help (nreverse msgs) "user" ?z)))
 )  
1783    
1784  (defun calc-user-function-classify (key)  (defun calc-user-function-classify (key)
1785    (cond ((/= key (downcase key))    ; upper-case    (cond ((/= key (downcase key))    ; upper-case
1786           (if (assq (downcase key) (calc-user-key-map)) 9 1))           (if (assq (downcase key) (calc-user-key-map)) 9 1))
1787          ((/= key (upcase key)) 2)   ; lower-case          ((/= key (upcase key)) 2)   ; lower-case
1788          ((= key ??) 0)          ((= key ??) 0)
1789          (t 4))   ; other          (t 4)))   ; other
 )  
1790    
1791  (defun calc-user-function-list (map flags)  (defun calc-user-function-list (map flags)
1792    (and map    (and map
# Line 1862  calc-kill calc-kill-region calc-yank) Line 1821  calc-kill calc-kill-region calc-yank)
1821                           buf (concat (if (= flags 1) "SHIFT + " "")                           buf (concat (if (= flags 1) "SHIFT + " "")
1822                                       desc))                                       desc))
1823                   (setq buf (concat buf ", " desc))))))                   (setq buf (concat buf ", " desc))))))
1824           (calc-user-function-list (cdr map) flags)))           (calc-user-function-list (cdr map) flags))))
 )  
1825    
1826    
1827    
# Line 1876  calc-kill calc-kill-region calc-yank) Line 1834  calc-kill calc-kill-region calc-yank)
1834       "kbd-macros: < > (repeat), ( ) (for), { } (loop)"       "kbd-macros: < > (repeat), ( ) (for), { } (loop)"
1835       "kbd-macros: / (break)"       "kbd-macros: / (break)"
1836       "kbd-macros: ` (save), ' (restore)")       "kbd-macros: ` (save), ' (restore)")
1837     "user" ?Z)     "user" ?Z))
 )  
1838    
1839    
1840  ;;;; Caches.  ;;;; Caches.
# Line 1920  calc-kill calc-kill-region calc-yank) Line 1877  calc-kill calc-kill-region calc-yank)
1877                                                      '(+ calc-internal-prec 2)))                                                      '(+ calc-internal-prec 2)))
1878                                          cache-val))                                          cache-val))
1879                              last-prec 'calc-internal-prec))                              last-prec 'calc-internal-prec))
1880                  last-val)))                  last-val))))
 )  
1881  (put 'math-defcache 'lisp-indent-hook 2)  (put 'math-defcache 'lisp-indent-hook 2)
1882    
1883  ;;; Betcha didn't know that pi = 16 atan(1/5) - 4 atan(1/239).   [F] [Public]  ;;; Betcha didn't know that pi = 16 atan(1/5) - 4 atan(1/239).   [F] [Public]
# Line 1976  calc-kill calc-kill-region calc-yank) Line 1932  calc-kill calc-kill-region calc-yank)
1932        (if symb        (if symb
1933            '(var pi var-pi)            '(var pi var-pi)
1934          (math-pi))          (math-pi))
1935      180)      180))
 )  
1936    
1937  (defun math-full-circle (symb)  (defun math-full-circle (symb)
1938    (math-mul 2 (math-half-circle symb))    (math-mul 2 (math-half-circle symb)))
 )  
1939    
1940  (defun math-quarter-circle (symb)  (defun math-quarter-circle (symb)
1941    (math-div (math-half-circle symb) 2)    (math-div (math-half-circle symb) 2))
 )  
1942    
1943    
1944    
# Line 1997  calc-kill calc-kill-region calc-yank) Line 1950  calc-kill calc-kill-region calc-yank)
1950    (if (consp a)    (if (consp a)
1951        (and (memq (car a) '(bigpos bigneg))        (and (memq (car a) '(bigpos bigneg))
1952             (= (% (nth 1 a) 2) 1))             (= (% (nth 1 a) 2) 1))
1953      (/= (% a 2) 0))      (/= (% a 2) 0)))
 )  
1954    
1955  ;;; True if A is a small or big integer.  [P x] [Public]  ;;; True if A is a small or big integer.  [P x] [Public]
1956  (defun math-integerp (a)  (defun math-integerp (a)
1957    (or (integerp a)    (or (integerp a)
1958        (memq (car-safe a) '(bigpos bigneg)))        (memq (car-safe a) '(bigpos bigneg))))
 )  
1959    
1960  ;;; True if A is (numerically) a non-negative integer.  [P N] [Public]  ;;; True if A is (numerically) a non-negative integer.  [P N] [Public]
1961  (defun math-natnump (a)  (defun math-natnump (a)
1962    (or (natnump a)    (or (natnump a)
1963        (eq (car-safe a) 'bigpos))        (eq (car-safe a) 'bigpos)))
 )  
1964    
1965  ;;; True if A is a rational (or integer).  [P x] [Public]  ;;; True if A is a rational (or integer).  [P x] [Public]
1966  (defun math-ratp (a)  (defun math-ratp (a)
1967    (or (integerp a)    (or (integerp a)
1968        (memq (car-safe a) '(bigpos bigneg frac)))        (memq (car-safe a) '(bigpos bigneg frac))))
 )  
1969    
1970  ;;; True if A is a real (or rational).  [P x] [Public]  ;;; True if A is a real (or rational).  [P x] [Public]
1971  (defun math-realp (a)  (defun math-realp (a)
1972    (or (integerp a)    (or (integerp a)
1973        (memq (car-safe a) '(bigpos bigneg frac float)))        (memq (car-safe a) '(bigpos bigneg frac float))))
 )  
1974    
1975  ;;; True if A is a real or HMS form.  [P x] [Public]  ;;; True if A is a real or HMS form.  [P x] [Public]
1976  (defun math-anglep (a)  (defun math-anglep (a)
1977    (or (integerp a)    (or (integerp a)
1978        (memq (car-safe a) '(bigpos bigneg frac float hms)))        (memq (car-safe a) '(bigpos bigneg frac float hms))))
 )  
1979    
1980  ;;; True if A is a number of any kind.  [P x] [Public]  ;;; True if A is a number of any kind.  [P x] [Public]
1981  (defun math-numberp (a)  (defun math-numberp (a)
1982    (or (integerp a)    (or (integerp a)
1983        (memq (car-safe a) '(bigpos bigneg frac float cplx polar)))        (memq (car-safe a) '(bigpos bigneg frac float cplx polar))))
 )  
1984    
1985  ;;; True if A is a complex number or angle.  [P x] [Public]  ;;; True if A is a complex number or angle.  [P x] [Public]
1986  (defun math-scalarp (a)  (defun math-scalarp (a)
1987    (or (integerp a)    (or (integerp a)
1988        (memq (car-safe a) '(bigpos bigneg frac float cplx polar hms)))        (memq (car-safe a) '(bigpos bigneg frac float cplx polar hms))))
 )  
1989    
1990  ;;; True if A is a vector.  [P x] [Public]  ;;; True if A is a vector.  [P x] [Public]
1991  (defun math-vectorp (a)  (defun math-vectorp (a)
1992    (eq (car-safe a) 'vec)    (eq (car-safe a) 'vec))
 )  
1993    
1994  ;;; True if A is any vector or scalar data object.  [P x]  ;;; True if A is any vector or scalar data object.  [P x]
1995  (defun math-objvecp (a)    ;  [Public]  (defun math-objvecp (a)    ;  [Public]
1996    (or (integerp a)    (or (integerp a)
1997        (memq (car-safe a) '(bigpos bigneg frac float cplx polar        (memq (car-safe a) '(bigpos bigneg frac float cplx polar
1998                                    hms date sdev intv mod vec incomplete)))                                    hms date sdev intv mod vec incomplete))))
 )  
1999    
2000  ;;; True if A is an object not composed of sub-formulas .  [P x] [Public]  ;;; True if A is an object not composed of sub-formulas .  [P x] [Public]
2001  (defun math-primp (a)  (defun math-primp (a)
2002    (or (integerp a)    (or (integerp a)
2003        (memq (car-safe a) '(bigpos bigneg frac float cplx polar        (memq (car-safe a) '(bigpos bigneg frac float cplx polar
2004                                    hms date mod var)))                                    hms date mod var))))
 )  
2005    
2006  ;;; True if A is numerically (but not literally) an integer.  [P x] [Public]  ;;; True if A is numerically (but not literally) an integer.  [P x] [Public]
2007  (defun math-messy-integerp (a)  (defun math-messy-integerp (a)
2008    (cond    (cond
2009     ((eq (car-safe a) 'float) (>= (nth 2 a) 0))     ((eq (car-safe a) 'float) (>= (nth 2 a) 0))
2010     ((eq (car-safe a) 'frac) (Math-integerp (math-normalize a))))     ((eq (car-safe a) 'frac) (Math-integerp (math-normalize a)))))
 )  
2011    
2012  ;;; True if A is numerically an integer.  [P x] [Public]  ;;; True if A is numerically an integer.  [P x] [Public]
2013  (defun math-num-integerp (a)  (defun math-num-integerp (a)
2014    (or (Math-integerp a)    (or (Math-integerp a)
2015        (Math-messy-integerp a))        (Math-messy-integerp a)))
 )  
2016    
2017  ;;; True if A is (numerically) a non-negative integer.  [P N] [Public]  ;;; True if A is (numerically) a non-negative integer.  [P N] [Public]
2018  (defun math-num-natnump (a)  (defun math-num-natnump (a)
# Line 2080  calc-kill calc-kill-region calc-yank) Line 2020  calc-kill calc-kill-region calc-yank)
2020        (eq (car-safe a) 'bigpos)        (eq (car-safe a) 'bigpos)
2021        (and (eq (car-safe a) 'float)        (and (eq (car-safe a) 'float)
2022             (Math-natnump (nth 1 a))             (Math-natnump (nth 1 a))
2023             (>= (nth 2 a) 0)))             (>= (nth 2 a) 0))))
 )  
2024    
2025  ;;; True if A is an integer or will evaluate to an integer.  [P x] [Public]  ;;; True if A is an integer or will evaluate to an integer.  [P x] [Public]
2026  (defun math-provably-integerp (a)  (defun math-provably-integerp (a)
# Line 2092  calc-kill calc-kill-region calc-yank) Line 2031  calc-kill calc-kill-region calc-yank)
2031                                  calcFunc-roundu                                  calcFunc-roundu
2032                                  calcFunc-floor                                  calcFunc-floor
2033                                  calcFunc-ceil))                                  calcFunc-ceil))
2034             (= (length a) 2)))             (= (length a) 2))))
 )  
2035    
2036  ;;; True if A is a real or will evaluate to a real.  [P x] [Public]  ;;; True if A is a real or will evaluate to a real.  [P x] [Public]
2037  (defun math-provably-realp (a)  (defun math-provably-realp (a)
2038    (or (Math-realp a)    (or (Math-realp a)
2039        (math-provably-integer a)        (math-provably-integer a)
2040        (memq (car-safe a) '(abs arg)))        (memq (car-safe a) '(abs arg))))
 )  
2041    
2042  ;;; True if A is a non-real, complex number.  [P x] [Public]  ;;; True if A is a non-real, complex number.  [P x] [Public]
2043  (defun math-complexp (a)  (defun math-complexp (a)
2044    (memq (car-safe a) '(cplx polar))    (memq (car-safe a) '(cplx polar)))
 )  
2045    
2046  ;;; True if A is a non-real, rectangular complex number.  [P x] [Public]  ;;; True if A is a non-real, rectangular complex number.  [P x] [Public]
2047  (defun math-rect-complexp (a)  (defun math-rect-complexp (a)
2048    (eq (car-safe a) 'cplx)    (eq (car-safe a) 'cplx))
 )  
2049    
2050  ;;; True if A is a non-real, polar complex number.  [P x] [Public]  ;;; True if A is a non-real, polar complex number.  [P x] [Public]
2051  (defun math-polar-complexp (a)  (defun math-polar-complexp (a)
2052    (eq (car-safe a) 'polar)    (eq (car-safe a) 'polar))
 )  
2053    
2054  ;;; True if A is a matrix.  [P x] [Public]  ;;; True if A is a matrix.  [P x] [Public]
2055  (defun math-matrixp (a)  (defun math-matrixp (a)
# Line 2127  calc-kill calc-kill-region calc-yank) Line 2061  calc-kill calc-kill-region calc-yank)
2061           (while (and (setq a (cdr a))           (while (and (setq a (cdr a))
2062                       (Math-vectorp (car a))                       (Math-vectorp (car a))
2063                       (= (length (car a)) len)))                       (= (length (car a)) len)))
2064           (null a)))           (null a))))
 )  
2065    
2066  (defun math-matrixp-step (a len)   ; [P L]  (defun math-matrixp-step (a len)   ; [P L]
2067    (or (null a)    (or (null a)
2068        (and (Math-vectorp (car a))        (and (Math-vectorp (car a))
2069             (= (length (car a)) len)             (= (length (car a)) len)
2070             (math-matrixp-step (cdr a) len)))             (math-matrixp-step (cdr a) len))))
 )  
2071    
2072  ;;; True if A is a square matrix.  [P V] [Public]  ;;; True if A is a square matrix.  [P V] [Public]
2073  (defun math-square-matrixp (a)  (defun math-square-matrixp (a)
2074    (let ((dims (math-mat-dimens a)))    (let ((dims (math-mat-dimens a)))
2075      (and (cdr dims)      (and (cdr dims)
2076           (= (car dims) (nth 1 dims))))           (= (car dims) (nth 1 dims)))))
 )  
2077    
2078  ;;; True if A is any scalar data object.  [P x]  ;;; True if A is any scalar data object.  [P x]
2079  (defun math-objectp (a)    ;  [Public]  (defun math-objectp (a)    ;  [Public]
2080    (or (integerp a)    (or (integerp a)
2081        (memq (car-safe a) '(bigpos bigneg frac float cplx        (memq (car-safe a) '(bigpos bigneg frac float cplx
2082                                    polar hms date sdev intv mod)))                                    polar hms date sdev intv mod))))
 )  
2083    
2084  ;;; Verify that A is an integer and return A in integer form.  [I N; - x]  ;;; Verify that A is an integer and return A in integer form.  [I N; - x]
2085  (defun math-check-integer (a)   ;  [Public]  (defun math-check-integer (a)   ;  [Public]
# Line 2157  calc-kill calc-kill-region calc-yank) Line 2087  calc-kill calc-kill-region calc-yank)
2087          ((math-integerp a) a)          ((math-integerp a) a)
2088          ((math-messy-integerp a)          ((math-messy-integerp a)
2089           (math-trunc a))           (math-trunc a))
2090          (t (math-reject-arg a 'integerp)))          (t (math-reject-arg a 'integerp))))
 )  
2091    
2092  ;;; Verify that A is a small integer and return A in integer form.  [S N; - x]  ;;; Verify that A is a small integer and return A in integer form.  [S N; - x]
2093  (defun math-check-fixnum (a &optional allow-inf)   ;  [Public]  (defun math-check-fixnum (a &optional allow-inf)   ;  [Public]
# Line 2175  calc-kill calc-kill-region calc-yank) Line 2104  calc-kill calc-kill-region calc-yank)
2104           (lsh -1 -1))           (lsh -1 -1))
2105          ((and allow-inf (equal a '(neg (var inf var-inf))))          ((and allow-inf (equal a '(neg (var inf var-inf))))
2106           (- (lsh -1 -1)))           (- (lsh -1 -1)))
2107          (t (math-reject-arg a 'fixnump)))          (t (math-reject-arg a 'fixnump))))
 )  
2108    
2109  ;;; Verify that A is an integer >= 0 and return A in integer form.  [I N; - x]  ;;; Verify that A is an integer >= 0 and return A in integer form.  [I N; - x]
2110  (defun math-check-natnum (a)    ;  [Public]  (defun math-check-natnum (a)    ;  [Public]
# Line 2184  calc-kill calc-kill-region calc-yank) Line 2112  calc-kill calc-kill-region calc-yank)
2112          ((and (not (math-negp a))          ((and (not (math-negp a))
2113                (Math-num-integerp a))                (Math-num-integerp a))
2114           (math-trunc a))           (math-trunc a))
2115          (t (math-reject-arg a 'natnump)))          (t (math-reject-arg a 'natnump))))
 )  
2116    
2117  ;;; Verify that A is in floating-point form, or force it to be a float.  [F N]  ;;; Verify that A is in floating-point form, or force it to be a float.  [F N]
2118  (defun math-check-float (a)    ; [Public]  (defun math-check-float (a)    ; [Public]
2119    (cond ((eq (car-safe a) 'float) a)    (cond ((eq (car-safe a) 'float) a)
2120          ((Math-vectorp a) (math-map-vec 'math-check-float a))          ((Math-vectorp a) (math-map-vec 'math-check-float a))
2121          ((Math-objectp a) (math-float a))          ((Math-objectp a) (math-float a))
2122          (t a))          (t a)))
 )  
2123    
2124  ;;; Verify that A is a constant.  ;;; Verify that A is a constant.
2125  (defun math-check-const (a &optional exp-ok)  (defun math-check-const (a &optional exp-ok)
2126    (if (or (math-constp a)    (if (or (math-constp a)
2127            (and exp-ok math-expand-formulas))            (and exp-ok math-expand-formulas))
2128        a        a
2129      (math-reject-arg a 'constp))      (math-reject-arg a 'constp)))
 )  
2130    
2131    
2132  ;;; Coerce integer A to be a small integer.  [S I]  ;;; Coerce integer A to be a small integer.  [S I]
# Line 2212  calc-kill calc-kill-region calc-yank) Line 2137  calc-kill calc-kill-region calc-yank)
2137                (- (math-fixnum-big (cdr a)))                (- (math-fixnum-big (cdr a)))
2138              (math-fixnum-big (cdr a)))              (math-fixnum-big (cdr a)))
2139          0)          0)
2140      a)      a))
 )  
2141    
2142  (defun math-fixnum-big (a)  (defun math-fixnum-big (a)
2143    (if (cdr a)    (if (cdr a)
2144        (+ (car a) (* (math-fixnum-big (cdr a)) 1000))        (+ (car a) (* (math-fixnum-big (cdr a)) 1000))
2145      (car a))      (car a)))
 )  
2146    
2147    
2148  (defun math-normalize-fancy (a)  (defun math-normalize-fancy (a)
# Line 2289  calc-kill calc-kill-region calc-yank) Line 2212  calc-kill calc-kill-region calc-yank)
2212          ((or (integerp (car a)) (consp (car a)))          ((or (integerp (car a)) (consp (car a)))
2213           (if (null (cdr a))           (if (null (cdr a))
2214               (math-normalize (car a))               (math-normalize (car a))
2215             (error "Can't use multi-valued function in an expression"))))             (error "Can't use multi-valued function in an expression")))))
 )  
2216    
2217  (defun math-normalize-nonstandard ()   ; uses "a"  (defun math-normalize-nonstandard ()   ; uses "a"
2218    (if (consp calc-simplify-mode)    (if (consp calc-simplify-mode)
# Line 2307  calc-kill calc-kill-region calc-yank) Line 2229  calc-kill calc-kill-region calc-yank)
2229                      (while (and aptr (math-constp (car aptr)))                      (while (and aptr (math-constp (car aptr)))
2230                        (setq aptr (cdr aptr)))                        (setq aptr (cdr aptr)))
2231                      aptr)))                      aptr)))
2232           (cons (car a) (mapcar 'math-normalize (cdr a)))))           (cons (car a) (mapcar 'math-normalize (cdr a))))))
 )  
2233    
2234    
2235    
# Line 2324  calc-kill calc-kill-region calc-yank) Line 2245  calc-kill calc-kill-region calc-yank)
2245      (and last      (and last
2246           (progn           (progn
2247             (setcdr last nil)             (setcdr last nil)
2248             a)))             a))))
 )  
2249    
2250  (defun math-bignum-test (a)   ; [B N; B s; b b]  (defun math-bignum-test (a)   ; [B N; B s; b b]
2251    (if (consp a)    (if (consp a)
2252        a        a
2253      (math-bignum a))      (math-bignum a)))
 )  
2254    
2255    
2256  ;;; Return 0 for zero, -1 for negative, 1 for positive.  [S n] [Public]  ;;; Return 0 for zero, -1 for negative, 1 for positive.  [S n] [Public]
# Line 2344  calc-kill calc-kill-region calc-yank) Line 2263  calc-kill calc-kill-region calc-yank)
2263            (t (calc-record-why 'realp a)            (t (calc-record-why 'realp a)
2264               (if x               (if x
2265                   (list 'calcFunc-sign a x)                   (list 'calcFunc-sign a x)
2266                 (list 'calcFunc-sign a)))))                 (list 'calcFunc-sign a))))))
 )  
2267    
2268  ;;; Return 0 if A is numerically equal to B, <0 if less, >0 if more.  ;;; Return 0 if A is numerically equal to B, <0 if less, >0 if more.
2269  ;;; Arguments must be normalized!  [S N N]  ;;; Arguments must be normalized!  [S N N]
# Line 2457  calc-kill calc-kill-region calc-yank) Line 2375  calc-kill calc-kill-region calc-yank)
2375                    (eq (car a) (car b))                    (eq (car a) (car b))
2376                    (math-compare-lists (cdr a) (cdr b)))                    (math-compare-lists (cdr a) (cdr b)))
2377               0               0
2378             2)))             2))))
 )  
2379    
2380  ;;; Compare two bignum digit lists, return -1 for A<B, 0 for A=B, 1 for A>B.  ;;; Compare two bignum digit lists, return -1 for A<B, 0 for A=B, 1 for A>B.
2381  (defun math-compare-bignum (a b)   ; [S l l]  (defun math-compare-bignum (a b)   ; [S l l]
# Line 2475  calc-kill calc-kill-region calc-yank) Line 2392  calc-kill calc-kill-region calc-yank)
2392            (while (eq (car a) 0) (setq a (cdr a)))            (while (eq (car a) 0) (setq a (cdr a)))
2393            (if a 1 res))            (if a 1 res))
2394        (while (eq (car b) 0) (setq b (cdr b)))        (while (eq (car b) 0) (setq b (cdr b)))
2395        (if b -1 res)))        (if b -1 res))))
 )  
2396    
2397  (defun math-compare-lists (a b)  (defun math-compare-lists (a b)
2398    (cond ((null a) (null b))    (cond ((null a) (null b))
2399          ((null b) nil)          ((null b) nil)
2400          (t (and (Math-equal (car a) (car b))          (t (and (Math-equal (car a) (car b))
2401                  (math-compare-lists (cdr a) (cdr b)))))                  (math-compare-lists (cdr a) (cdr b))))))
 )  
2402    
2403  (defun math-lessp-float (a b)   ; [P F F]  (defun math-lessp-float (a b)   ; [P F F]
2404    (let ((ediff (- (nth 2 a) (nth 2 b))))    (let ((ediff (- (nth 2 a) (nth 2 b))))
# Line 2500  calc-kill calc-kill-region calc-yank) Line 2415  calc-kill calc-kill-region calc-yank)
2415                (Math-integer-negp (nth 1 a))                (Math-integer-negp (nth 1 a))
2416              (Math-integer-posp (nth 1 b)))              (Math-integer-posp (nth 1 b)))
2417          (Math-lessp (nth 1 a)          (Math-lessp (nth 1 a)
2418                      (math-scale-int (nth 1 b) ediff)))))                      (math-scale-int (nth 1 b) ediff))))))
 )  
2419    
2420  ;;; True if A is numerically equal to B.  [P N N] [Public]  ;;; True if A is numerically equal to B.  [P N N] [Public]
2421  (defun math-equal (a b)  (defun math-equal (a b)
2422    (= (math-compare a b) 0)    (= (math-compare a b) 0))
 )  
2423    
2424  ;;; True if A is numerically less than B.  [P R R] [Public]  ;;; True if A is numerically less than B.  [P R R] [Public]
2425  (defun math-lessp (a b)  (defun math-lessp (a b)
2426    (= (math-compare a b) -1)    (= (math-compare a b) -1))
 )  
2427    
2428  ;;; True if A is numerically equal to the integer B.  [P N S] [Public]  ;;; True if A is numerically equal to the integer B.  [P N S] [Public]
2429  ;;; B must not be a multiple of 10.  ;;; B must not be a multiple of 10.
# Line 2519  calc-kill calc-kill-region calc-yank) Line 2431  calc-kill calc-kill-region calc-yank)
2431    (or (eq a b)    (or (eq a b)
2432        (and (eq (car-safe a) 'float)        (and (eq (car-safe a) 'float)
2433             (eq (nth 1 a) b)             (eq (nth 1 a) b)
2434             (= (nth 2 a) 0)))             (= (nth 2 a) 0))))
 )  
2435    
2436    
2437    
# Line 2532  calc-kill calc-kill-region calc-yank) Line 2443  calc-kill calc-kill-region calc-yank)
2443            (cons (1- (length m))            (cons (1- (length m))
2444                  (math-mat-dimens (nth 1 m)))                  (math-mat-dimens (nth 1 m)))
2445          (list (1- (length m))))          (list (1- (length m))))
2446      nil)      nil))
 )  
2447    
2448    
2449    
# Line 2559  calc-kill calc-kill-region calc-yank) Line 2469  calc-kill calc-kill-region calc-yank)
2469                                  (mapcar (function                                  (mapcar (function
2470                                           (lambda (x)                                           (lambda (x)
2471                                             (list func x rhs)))                                             (list func x rhs)))
2472                                          (calc-top-list-n (- n) 2)))))))                                          (calc-top-list-n (- n) 2))))))))
 )  
2473    
2474  (defun calc-unary-op-fancy (name func arg)  (defun calc-unary-op-fancy (name func arg)
2475    (let ((n (prefix-numeric-value arg)))    (let ((n (prefix-numeric-value arg)))
# Line 2576  calc-kill calc-kill-region calc-yank) Line 2485  calc-kill calc-kill-region calc-yank)
2485             (calc-enter-result 1             (calc-enter-result 1
2486                                name                                name
2487                                (list func (calc-top-n (- n)))                                (list func (calc-top-n (- n)))
2488                                (- n)))))                                (- n))))))
 )  
2489    
2490    
2491    
# Line 2593  calc-kill calc-kill-region calc-yank) Line 2501  calc-kill calc-kill-region calc-yank)
2501    
2502  (defun math-inexact-result ()  (defun math-inexact-result ()
2503    (and calc-symbolic-mode    (and calc-symbolic-mode
2504         (signal 'inexact-result nil))         (signal 'inexact-result nil)))
 )  
2505    
2506  (defun math-overflow (&optional exp)  (defun math-overflow (&optional exp)
2507    (if (and exp (math-negp exp))    (if (and exp (math-negp exp))
2508        (math-underflow)        (math-underflow)
2509      (signal 'math-overflow nil))      (signal 'math-overflow nil)))
 )  
2510    
2511  (defun math-underflow ()  (defun math-underflow ()
2512    (signal 'math-underflow nil)    (signal 'math-underflow nil))
 )  
2513    
2514    
2515    
# Line 2637  calc-kill calc-kill-region calc-yank) Line 2542  calc-kill calc-kill-region calc-yank)
2542               (setq c b               (setq c b
2543                     b (% a b)                     b (% a b)
2544                     a c))                     a c))
2545             a)))             a))))
 )  
2546    
2547    
2548  ;;;; Algebra.  ;;;; Algebra.
# Line 2647  calc-kill calc-kill-region calc-yank) Line 2551  calc-kill calc-kill-region calc-yank)
2551  (defun math-evaluate-expr (x)  ; [Public]  (defun math-evaluate-expr (x)  ; [Public]
2552    (if calc-embedded-info    (if calc-embedded-info
2553        (calc-embedded-evaluate-expr x)        (calc-embedded-evaluate-expr x)
2554      (calc-normalize (math-evaluate-expr-rec x)))      (calc-normalize (math-evaluate-expr-rec x))))
2555  )  
2556  (fset 'calcFunc-evalv (symbol-function 'math-evaluate-expr))  (defalias 'calcFunc-evalv 'math-evaluate-expr)
2557    
2558  (defun calcFunc-evalvn (x &optional prec)  (defun calcFunc-evalvn (x &optional prec)
2559    (if prec    (if prec
# Line 2669  calc-kill calc-kill-region calc-yank) Line 2573  calc-kill calc-kill-region calc-yank)
2573            (let ((calc-internal-prec prec))            (let ((calc-internal-prec prec))
2574              (calcFunc-evalvn x))))              (calcFunc-evalvn x))))
2575      (let ((calc-symbolic-mode nil))      (let ((calc-symbolic-mode nil))
2576        (math-evaluate-expr x)))        (math-evaluate-expr x))))
 )  
2577    
2578  (defun math-evaluate-expr-rec (x)  (defun math-evaluate-expr-rec (x)
2579    (if (consp x)    (if (consp x)
# Line 2694  calc-kill calc-kill-region calc-yank) Line 2597  calc-kill calc-kill-region calc-yank)
2597            (if (Math-primp x)            (if (Math-primp x)
2598                x                x
2599              (cons (car x) (mapcar 'math-evaluate-expr-rec (cdr x))))))              (cons (car x) (mapcar 'math-evaluate-expr-rec (cdr x))))))
2600      x)      x))
 )  
   
   
2601    
2602  (setq math-simplifying nil)  (setq math-simplifying nil)
2603  (setq math-living-dangerously nil)   ; true if unsafe simplifications are okay.  (setq math-living-dangerously nil)   ; true if unsafe simplifications are okay.
2604  (setq math-integrating nil)  (setq math-integrating nil)
2605    
   
   
   
2606  (defmacro math-defsimplify (funcs &rest code)  (defmacro math-defsimplify (funcs &rest code)
2607    (append '(progn (math-need-std-simps))    (append '(progn (math-need-std-simps))
2608            (mapcar (function            (mapcar (function
# Line 2717  calc-kill calc-kill-region calc-yank) Line 2614  calc-kill calc-kill-region calc-yank)
2614                                         (list 'function                                         (list 'function
2615                                               (append '(lambda (expr))                                               (append '(lambda (expr))
2616                                                       code)))))))                                                       code)))))))
2617                    (if (symbolp funcs) (list funcs) funcs)))                    (if (symbolp funcs) (list funcs) funcs))))
 )  
2618  (put 'math-defsimplify 'lisp-indent-hook 1)  (put 'math-defsimplify 'lisp-indent-hook 1)
2619    
   
2620  (defun math-any-floats (expr)  (defun math-any-floats (expr)
2621    (if (Math-primp expr)    (if (Math-primp expr)
2622        (math-floatp expr)        (math-floatp expr)
2623      (while (and (setq expr (cdr expr)) (not (math-any-floats (car expr)))))      (while (and (setq expr (cdr expr)) (not (math-any-floats (car expr)))))
2624      expr)      expr))
 )  
2625    
2626  (defvar var-FactorRules 'calc-FactorRules)  (defvar var-FactorRules 'calc-FactorRules)
2627    
   
   
2628  (defun math-map-tree (mmt-func mmt-expr &optional mmt-many)  (defun math-map-tree (mmt-func mmt-expr &optional mmt-many)
2629    (or mmt-many (setq mmt-many 1000000))    (or mmt-many (setq mmt-many 1000000))
2630    (math-map-tree-rec mmt-expr)    (math-map-tree-rec mmt-expr))
 )  
2631    
2632  (defun math-map-tree-rec (mmt-expr)  (defun math-map-tree-rec (mmt-expr)
2633    (or (= mmt-many 0)    (or (= mmt-many 0)
# Line 2757  calc-kill calc-kill-region calc-yank) Line 2648  calc-kill calc-kill-region calc-yank)
2648              (if (equal mmt-nextval mmt-expr)              (if (equal mmt-nextval mmt-expr)
2649                  (setq mmt-done t)                  (setq mmt-done t)
2650                (setq mmt-expr mmt-nextval))))))                (setq mmt-expr mmt-nextval))))))
2651    mmt-expr    mmt-expr)
 )  
   
   
   
2652    
2653  (setq math-rewrite-selections nil)  (setq math-rewrite-selections nil)
2654    
2655  (defun math-is-true (expr)  (defun math-is-true (expr)
2656    (if (Math-numberp expr)    (if (Math-numberp expr)
2657        (not (Math-zerop expr))        (not (Math-zerop expr))
2658      (math-known-nonzerop expr))      (math-known-nonzerop expr)))
 )  
2659    
2660  (defun math-const-var (expr)  (defun math-const-var (expr)
2661    (and (consp expr)    (and (consp expr)
# Line 2777  calc-kill calc-kill-region calc-yank) Line 2663  calc-kill calc-kill-region calc-yank)
2663         (or (and (symbolp (nth 2 expr))         (or (and (symbolp (nth 2 expr))
2664                  (boundp (nth 2 expr))                  (boundp (nth 2 expr))
2665                  (eq (car-safe (symbol-value (nth 2 expr))) 'special-const))                  (eq (car-safe (symbol-value (nth 2 expr))) 'special-const))
2666             (memq (nth 2 expr) '(var-inf var-uinf var-nan))))             (memq (nth 2 expr) '(var-inf var-uinf var-nan)))))
 )  
   
   
   
2667    
2668  (defmacro math-defintegral (funcs &rest code)  (defmacro math-defintegral (funcs &rest code)
2669    (setq math-integral-cache nil)    (setq math-integral-cache nil)
# Line 2795  calc-kill calc-kill-region calc-yank) Line 2677  calc-kill calc-kill-region calc-yank)
2677                                         (list 'function                                         (list 'function
2678                                               (append '(lambda (u))                                               (append '(lambda (u))
2679                                                       code)))))))                                                       code)))))))
2680                    (if (symbolp funcs) (list funcs) funcs)))                    (if (symbolp funcs) (list funcs) funcs))))
 )  
2681  (put 'math-defintegral 'lisp-indent-hook 1)  (put 'math-defintegral 'lisp-indent-hook 1)
2682    
2683  (defmacro math-defintegral-2 (funcs &rest code)  (defmacro math-defintegral-2 (funcs &rest code)
# Line 2812  calc-kill calc-kill-region calc-yank) Line 2693  calc-kill calc-kill-region calc-yank)
2693                                         (list 'function                                         (list 'function
2694                                               (append '(lambda (u v))                                               (append '(lambda (u v))
2695                                                       code)))))))                                                       code)))))))
2696                    (if (symbolp funcs) (list funcs) funcs)))                    (if (symbolp funcs) (list funcs) funcs))))
 )  
2697  (put 'math-defintegral-2 'lisp-indent-hook 1)  (put 'math-defintegral-2 'lisp-indent-hook 1)
2698    
   
2699  (defvar var-IntegAfterRules 'calc-IntegAfterRules)  (defvar var-IntegAfterRules 'calc-IntegAfterRules)
2700    
   
2701  (defvar var-FitRules 'calc-FitRules)  (defvar var-FitRules 'calc-FitRules)
2702    
   
2703  (setq math-poly-base-variable nil)  (setq math-poly-base-variable nil)
2704  (setq math-poly-neg-powers nil)  (setq math-poly-neg-powers nil)
2705  (setq math-poly-mult-powers 1)  (setq math-poly-mult-powers 1)
2706  (setq math-poly-frac-powers nil)  (setq math-poly-frac-powers nil)
2707  (setq math-poly-exp-base nil)  (setq math-poly-exp-base nil)
2708    
   
   
   
2709  (defun math-build-var-name (name)  (defun math-build-var-name (name)
2710    (if (stringp name)    (if (stringp name)
2711        (setq name (intern name)))        (setq name (intern name)))
2712    (if (string-match "\\`var-." (symbol-name name))    (if (string-match "\\`var-." (symbol-name name))
2713        (list 'var (intern (substring (symbol-name name) 4)) name)        (list 'var (intern (substring (symbol-name name) 4)) name)
2714      (list 'var name (intern (concat "var-" (symbol-name name)))))      (list 'var name (intern (concat "var-" (symbol-name name))))))
 )  
2715    
2716  (setq math-simplifying-units nil)  (setq math-simplifying-units nil)
2717  (setq math-combining-units t)  (setq math-combining-units t)
# Line 3007  calc-kill calc-kill-region calc-yank) Line 2880  calc-kill calc-kill-region calc-yank)
2880                                (math-match-substring s 2))))                                (math-match-substring s 2))))
2881    
2882     ;; Syntax error!     ;; Syntax error!
2883     (t nil))     (t nil)))
 )  
2884    
2885  (defun math-read-radix (s r)   ; [I X D]  (defun math-read-radix (s r)   ; [I X D]
2886    (setq s (upcase s))    (setq s (upcase s))
# Line 3021  calc-kill calc-kill-region calc-yank) Line 2893  calc-kill calc-kill-region calc-yank)
2893        (setq res (math-add (math-mul res r) dig)        (setq res (math-add (math-mul res r) dig)
2894              i (1+ i)))              i (1+ i)))
2895      (and (= i (length s))      (and (= i (length s))
2896           res))           res)))
 )  
2897    
2898    
2899    
# Line 3043  calc-kill calc-kill-region calc-yank) Line 2914  calc-kill calc-kill-region calc-yank)
2914            (list 'error exp-old-pos val)            (list 'error exp-old-pos val)
2915          (if (equal exp-token 'end)          (if (equal exp-token 'end)
2916              val              val
2917            (list 'error exp-old-pos "Syntax error")))))            (list 'error exp-old-pos "Syntax error"))))))
 )  
2918    
2919  (defun math-read-plain-expr (exp-str &optional error-check)  (defun math-read-plain-expr (exp-str &optional error-check)
2920    (let* ((calc-language nil)    (let* ((calc-language nil)
# Line 3053  calc-kill calc-kill-region calc-yank) Line 2923  calc-kill calc-kill-region calc-yank)
2923      (and error-check      (and error-check
2924           (eq (car-safe val) 'error)           (eq (car-safe val) 'error)
2925           (error "%s: %s" (nth 2 val) exp-str))           (error "%s: %s" (nth 2 val) exp-str))
2926      val)      val))
 )  
2927    
2928    
2929  (defun math-read-string ()  (defun math-read-string ()
# Line 3063  calc-kill calc-kill-region calc-yank) Line 2932  calc-kill calc-kill-region calc-yank)
2932               (stringp (car str)))               (stringp (car str)))
2933          (throw 'syntax "Error in string constant"))          (throw 'syntax "Error in string constant"))
2934      (math-read-token)      (math-read-token)
2935      (append '(vec) (car str) nil))      (append '(vec) (car str) nil)))
 )  
2936    
2937    
2938    
# Line 3107  calc-kill calc-kill-region calc-yank) Line 2975  calc-kill calc-kill-region calc-yank)
2975                  (math-read-big-rec 0 0 width (length lines)))                  (math-read-big-rec 0 0 width (length lines)))
2976                err-msg                err-msg
2977                '(error 0 "Syntax error"))                '(error 0 "Syntax error"))
2978          (math-read-expr str))))          (math-read-expr str)))))
 )  
2979    
2980  (defun math-read-big-bigp (lines)  (defun math-read-big-bigp (lines)
2981    (and (cdr lines)    (and (cdr lines)
# Line 3144  calc-kill calc-kill-region calc-yank) Line 3011  calc-kill calc-kill-region calc-yank)
3011                   v (1+ v)))                   v (1+ v)))
3012           (or (and (> height 1)           (or (and (> height 1)
3013                    (not (cdr lines)))                    (not (cdr lines)))
3014               matrix)))               matrix))))
 )  
3015    
3016    
3017    
# Line 3227  calc-kill calc-kill-region calc-yank) Line 3093  calc-kill calc-kill-region calc-yank)
3093                          (symbol-name (car a))))                          (symbol-name (car a))))
3094                       "("                       "("
3095                       (math-format-flat-vector (cdr a) ", " 0)                       (math-format-flat-vector (cdr a) ", " 0)
3096                       ")"))))))                       ")")))))))
 )  
3097  (setq math-format-hash-args nil)  (setq math-format-hash-args nil)
3098    
3099  (defun math-format-flat-vector (vec sep prec)  (defun math-format-flat-vector (vec sep prec)
# Line 3237  calc-kill calc-kill-region calc-yank) Line 3102  calc-kill calc-kill-region calc-yank)
3102          (while (setq vec (cdr vec))          (while (setq vec (cdr vec))
3103            (setq buf (concat buf sep (math-format-flat-expr (car vec) prec))))            (setq buf (concat buf sep (math-format-flat-expr (car vec) prec))))
3104          buf)          buf)
3105      "")      ""))
 )  
3106  (setq calc-can-abbrev-vectors nil)  (setq calc-can-abbrev-vectors nil)
3107    
3108  (defun math-format-nice-expr (x w)  (defun math-format-nice-expr (x w)
# Line 3265  calc-kill calc-kill-region calc-yank) Line 3129  calc-kill calc-kill-region calc-yank)
3129                                         (substring str p))                                         (substring str p))
3130                             pos (1+ p))                             pos (1+ p))
3131                     (setq pos (+ pos w)))))                     (setq pos (+ pos w)))))
3132             str)))             str))))
 )  
3133    
3134  (defun math-assq2 (v a)  (defun math-assq2 (v a)
3135    (while (and a (not (eq v (nth 1 (car a)))))    (while (and a (not (eq v (nth 1 (car a)))))
3136      (setq a (cdr a)))      (setq a (cdr a)))
3137    (car a)    (car a))
 )  
3138    
3139    
3140  (defun math-format-number-fancy (a prec)  (defun math-format-number-fancy (a prec)
# Line 3363  calc-kill calc-kill-region calc-yank) Line 3225  calc-kill calc-kill-region calc-yank)
3225              (math-format-number (nth 2 a))))              (math-format-number (nth 2 a))))
3226     ((eq (car a) 'vec)     ((eq (car a) 'vec)
3227      (math-format-flat-expr a 0))      (math-format-flat-expr a 0))
3228     (t (format "%s" a)))     (t (format "%s" a))))
 )  
3229    
3230  (defun math-adjust-fraction (a)  (defun math-adjust-fraction (a)
3231    (if (nth 1 calc-frac-format)    (if (nth 1 calc-frac-format)
# Line 3374  calc-kill calc-kill-region calc-yank) Line 3235  calc-kill calc-kill-region calc-yank)
3235                                  (math-gcd (nth 2 a)                                  (math-gcd (nth 2 a)
3236                                            (nth 1 calc-frac-format)))))                                            (nth 1 calc-frac-format)))))
3237            (list 'frac (math-mul (nth 1 a) g) (math-mul (nth 2 a) g))))            (list 'frac (math-mul (nth 1 a) g) (math-mul (nth 2 a) g))))
3238      a)      a))
 )  
3239    
3240  (defun math-format-bignum-fancy (a)   ; [X L]  (defun math-format-bignum-fancy (a)   ; [X L]
3241    (let ((str (cond ((= calc-number-radix 10)    (let ((str (cond ((= calc-number-radix 10)
# Line 3410  calc-kill calc-kill-region calc-yank) Line 3270  calc-kill calc-kill-region calc-yank)
3270          (if calc-radix-formatter          (if calc-radix-formatter
3271              (funcall calc-radix-formatter calc-number-radix str)              (funcall calc-radix-formatter calc-number-radix str)
3272            (format "%d#%s" calc-number-radix str))            (format "%d#%s" calc-number-radix str))
3273        str))        str)))
 )  
3274    
3275    
3276  (defun math-group-float (str)   ; [X X]  (defun math-group-float (str)   ; [X X]
# Line 3430  calc-kill calc-kill-region calc-yank) Line 3289  calc-kill calc-kill-region calc-yank)
3289              str (concat (substring str 0 i)              str (concat (substring str 0 i)
3290                          calc-group-char                          calc-group-char
3291                          (substring str i))))                          (substring str i))))
3292      str)      str))
 )  
   
   
   
   
   
   
   
3293    
3294  (setq math-compose-level 0)  (setq math-compose-level 0)
3295  (setq math-comp-selected nil)  (setq math-comp-selected nil)
# Line 3459  A command spec is a command name symbol, Line 3310  A command spec is a command name symbol,
3310  list containing a numeric entry string, or nil.  list containing a numeric entry string, or nil.
3311  A key may contain additional specs for Inverse, Hyperbolic, and Inv+Hyp.")  A key may contain additional specs for Inverse, Hyperbolic, and Inv+Hyp.")
3312    
   
   
   
   
3313  (run-hooks 'calc-ext-load-hook)  (run-hooks 'calc-ext-load-hook)
3314    
3315    ;;; calc-ext.el ends here
3316    
3317    

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