;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
(require 'calc-macs)
+;; Declare functions which are defined elsewhere.
+(declare-function calc-set-language "calc-lang" (lang &optional option no-refresh))
+(declare-function calc-edit-finish "calc-yank" (&optional keep))
+(declare-function calc-edit-cancel "calc-yank" ())
+(declare-function calc-do-quick-calc "calc-aent" ())
+(declare-function calc-do-calc-eval "calc-aent" (str separator args))
+(declare-function calc-do-keypad "calc-keypd" (&optional full-display interactive))
+(declare-function calcFunc-unixtime "calc-forms" (date &optional zone))
+(declare-function math-parse-date "calc-forms" (math-pd-str))
+(declare-function math-lessp "calc-ext" (a b))
+(declare-function calc-embedded-finish-command "calc-embed" ())
+(declare-function calc-embedded-select-buffer "calc-embed" ())
+(declare-function calc-embedded-mode-line-change "calc-embed" ())
+(declare-function calc-push-list-in-macro "calc-prog" (vals m sels))
+(declare-function calc-replace-selections "calc-sel" (n vals m))
+(declare-function calc-record-list "calc-misc" (vals &optional prefix))
+(declare-function calc-normalize-fancy "calc-ext" (val))
+(declare-function calc-do-handle-whys "calc-misc" ())
+(declare-function calc-top-selected "calc-sel" (&optional n m))
+(declare-function calc-sel-error "calc-sel" ())
+(declare-function calc-pop-stack-in-macro "calc-prog" (n mm))
+(declare-function calc-embedded-stack-change "calc-embed" ())
+(declare-function calc-refresh-evaltos "calc-ext" (&optional which-var))
+(declare-function calc-do-refresh "calc-misc" ())
+(declare-function calc-binary-op-fancy "calc-ext" (name func arg ident unary))
+(declare-function calc-unary-op-fancy "calc-ext" (name func arg))
+(declare-function calc-delete-selection "calc-sel" (n))
+(declare-function calc-alg-digit-entry "calc-aent" ())
+(declare-function calc-alg-entry "calc-aent" (&optional initial prompt))
+(declare-function calc-dots "calc-incom" ())
+(declare-function calc-temp-minibuffer-message "calc-misc" (m))
+(declare-function math-read-radix-digit "calc-misc" (dig))
+(declare-function calc-digit-dots "calc-incom" ())
+(declare-function math-normalize-fancy "calc-ext" (a))
+(declare-function math-normalize-nonstandard "calc-ext" ())
+(declare-function math-recompile-eval-rules "calc-alg" ())
+(declare-function math-apply-rewrites "calc-rewr" (expr rules &optional heads math-apply-rw-ruleset))
+(declare-function calc-record-why "calc-misc" (&rest stuff))
+(declare-function math-dimension-error "calc-vec" ())
+(declare-function calc-incomplete-error "calc-incom" (a))
+(declare-function math-float-fancy "calc-arith" (a))
+(declare-function math-neg-fancy "calc-arith" (a))
+(declare-function math-zerop "calc-misc" (a))
+(declare-function calc-add-fractions "calc-frac" (a b))
+(declare-function math-add-objects-fancy "calc-arith" (a b))
+(declare-function math-add-symb-fancy "calc-arith" (a b))
+(declare-function math-mul-zero "calc-arith" (a b))
+(declare-function calc-mul-fractions "calc-frac" (a b))
+(declare-function math-mul-objects-fancy "calc-arith" (a b))
+(declare-function math-mul-symb-fancy "calc-arith" (a b))
+(declare-function math-reject-arg "calc-misc" (&optional a p option))
+(declare-function math-div-by-zero "calc-arith" (a b))
+(declare-function math-div-zero "calc-arith" (a b))
+(declare-function math-make-frac "calc-frac" (num den))
+(declare-function calc-div-fractions "calc-frac" (a b))
+(declare-function math-div-objects-fancy "calc-arith" (a b))
+(declare-function math-div-symb-fancy "calc-arith" (a b))
+(declare-function math-compose-expr "calccomp" (a prec))
+(declare-function math-comp-width "calccomp" (c))
+(declare-function math-composition-to-string "calccomp" (c &optional width))
+(declare-function math-stack-value-offset-fancy "calccomp" ())
+(declare-function math-format-flat-expr-fancy "calc-ext" (a prec))
+(declare-function math-adjust-fraction "calc-ext" (a))
+(declare-function math-format-binary "calc-bin" (a))
+(declare-function math-format-radix "calc-bin" (a))
+(declare-function math-group-float "calc-ext" (str))
+(declare-function math-mod "calc-misc" (a b))
+(declare-function math-format-number-fancy "calc-ext" (a prec))
+(declare-function math-format-bignum-fancy "calc-ext" (a))
+(declare-function math-read-number-fancy "calc-ext" (s))
+(declare-function calc-do-grab-region "calc-yank" (top bot arg))
+(declare-function calc-do-grab-rectangle "calc-yank" (top bot arg &optional reduce))
+(declare-function calc-do-embedded "calc-embed" (calc-embed-arg end obeg oend))
+(declare-function calc-do-embedded-activate "calc-embed" (calc-embed-arg cbuf))
+(declare-function math-do-defmath "calc-prog" (func args body))
+(declare-function calc-load-everything "calc-ext" ())
+
+
(defgroup calc nil
"GNU Calc."
:prefix "calc-"
:group 'applications)
;;;###autoload
-(defcustom calc-settings-file
+(defcustom calc-settings-file
(convert-standard-filename "~/.calc.el")
"*File in which to record permanent settings."
:group 'calc
(c-mode . c)
(c++-mode . c)
(fortran-mode . fortran)
- (f90-mode . fortran))
+ (f90-mode . fortran)
+ (texinfo-mode . calc-normal-language))
"*Alist of major modes with appropriate Calc languages."
:group 'calc
- :type '(alist :key-type (symbol :tag "Major mode")
+ :type '(alist :key-type (symbol :tag "Major mode")
:value-type (symbol :tag "Calc language")))
-(defcustom calc-embedded-announce-formula
+(defcustom calc-embedded-announce-formula
"%Embed\n\\(% .*\n\\)*"
"*A regular expression which is sure to be followed by a calc-embedded formula."
:group 'calc
:type '(alist :key-type (symbol :tag "Major mode")
:value-type (regexp :tag "Regexp to announce formula")))
-(defcustom calc-embedded-open-formula
+(defcustom calc-embedded-open-formula
"\\`\\|^\n\\|\\$\\$?\\|\\\\\\[\\|^\\\\begin[^{].*\n\\|^\\\\begin{.*[^x]}.*\n\\|^@.*\n\\|^\\.EQ.*\n\\|\\\\(\\|^%\n\\|^\\.\\\\\"\n"
"*A regular expression for the opening delimiter of a formula used by calc-embedded."
:group 'calc
:type '(regexp))
-(defcustom calc-embedded-close-formula
+(defcustom calc-embedded-close-formula
"\\'\\|\n$\\|\\$\\$?\\|\\\\]\\|^\\\\end[^{].*\n\\|^\\\\end{.*[^x]}.*\n\\|^@.*\n\\|^\\.EN.*\n\\|\\\\)\\|\n%\n\\|^\\.\\\\\"\n"
"*A regular expression for the closing delimiter of a formula used by calc-embedded."
:group 'calc
:value-type (list (regexp :tag "Opening formula delimiter")
(regexp :tag "Closing formula delimiter"))))
-(defcustom calc-embedded-open-word
+(defcustom calc-embedded-open-word
"^\\|[^-+0-9.eE]"
"*A regular expression for the opening delimiter of a formula used by calc-embedded-word."
:group 'calc
:type '(regexp))
-(defcustom calc-embedded-close-word
+(defcustom calc-embedded-close-word
"$\\|[^-+0-9.eE]"
"*A regular expression for the closing delimiter of a formula used by calc-embedded-word."
:group 'calc
:value-type (list (regexp :tag "Opening word delimiter")
(regexp :tag "Closing word delimiter"))))
-(defcustom calc-embedded-open-plain
+(defcustom calc-embedded-open-plain
"%%% "
"*A string which is the opening delimiter for a \"plain\" formula.
If calc-show-plain mode is enabled, this is inserted at the front of
:group 'calc
:type '(string))
-(defcustom calc-embedded-close-plain
+(defcustom calc-embedded-close-plain
" %%%\n"
"*A string which is the closing delimiter for a \"plain\" formula.
See calc-embedded-open-plain."
:value-type (list (string :tag "Opening \"plain\" delimiter")
(string :tag "Closing \"plain\" delimiter"))))
-(defcustom calc-embedded-open-new-formula
+(defcustom calc-embedded-open-new-formula
"\n\n"
"*A string which is inserted at front of formula by calc-embedded-new-formula."
:group 'calc
:type '(string))
-(defcustom calc-embedded-close-new-formula
+(defcustom calc-embedded-close-new-formula
"\n\n"
"*A string which is inserted at end of formula by calc-embedded-new-formula."
:group 'calc
:value-type (list (string :tag "Opening new formula delimiter")
(string :tag "Closing new formula delimiter"))))
-(defcustom calc-embedded-open-mode
+(defcustom calc-embedded-open-mode
"% "
"*A string which should precede calc-embedded mode annotations.
This is not required to be present for user-written mode annotations."
:group 'calc
:type '(string))
-(defcustom calc-embedded-close-mode
+(defcustom calc-embedded-close-mode
"\n"
"*A string which should follow calc-embedded mode annotations.
This is not required to be present for user-written mode annotations."
:value-type (list (string :tag "Opening annotation delimiter")
(string :tag "Closing annotation delimiter"))))
-(defcustom calc-gnuplot-name
+(defcustom calc-gnuplot-name
"gnuplot"
"*Name of GNUPLOT program, for calc-graph features."
:group 'calc
:type '(string))
-(defcustom calc-gnuplot-plot-command
+(defcustom calc-gnuplot-plot-command
nil
"*Name of command for displaying GNUPLOT output; %s = file name to print."
:group 'calc
:type '(choice (string) (sexp)))
-(defcustom calc-gnuplot-print-command
+(defcustom calc-gnuplot-print-command
"lp %s"
"*Name of command for printing GNUPLOT output; %s = file name to print."
:group 'calc
(defcalcmodevar calc-point-char "."
"The character (in the form of a string) to be used as a decimal point.")
-
+
(defcalcmodevar calc-frac-format '(":" nil)
"Format of displayed fractions; a string of one or two of \":\" or \"/\".")
"YYddd< hh:mm:ss>"))
(defcalcmodevar calc-autorange-units nil)
-
+
(defcalcmodevar calc-was-keypad-mode nil)
-
+
(defcalcmodevar calc-full-mode nil)
(defcalcmodevar calc-user-parse-tables nil)
(defcalcmodevar calc-gnuplot-default-output "STDOUT")
(defcalcmodevar calc-gnuplot-print-device "postscript")
-
+
(defcalcmodevar calc-gnuplot-print-output "auto")
(defcalcmodevar calc-gnuplot-geometry nil)
(defcalcmodevar calc-graph-default-resolution 15)
(defcalcmodevar calc-graph-default-resolution-3d 5)
-
+
(defcalcmodevar calc-invocation-macro nil)
(defcalcmodevar calc-show-banner t
(defvar calc-embedded-mode-hook nil
"Hook run when starting embedded mode.")
-;; Verify that Calc is running on the right kind of system.
-(defvar calc-emacs-type-lucid (not (not (string-match "Lucid" emacs-version))))
-
;; Set up the autoloading linkage.
(let ((name (and (fboundp 'calc-dispatch)
(eq (car-safe (symbol-function 'calc-dispatch)) 'autoload)
"Function through which to pass strings before parsing.")
(defvar calc-radix-formatter nil
"Formatting function used for non-decimal numbers.")
+(defvar calc-lang-slash-idiv nil
+ "A list of languages in which / might represent integer division.")
+(defvar calc-lang-allow-underscores nil
+ "A list of languages which allow underscores in variable names.")
+(defvar calc-lang-c-type-hex nil
+ "Languages in which octal and hex numbers are written with leading 0 and 0x,")
+(defvar calc-lang-brackets-are-subscripts nil
+ "Languages in which subscripts are indicated by brackets.")
+(defvar calc-lang-parens-are-subscripts nil
+ "Languages in which subscripts are indicated by parentheses.")
(defvar calc-last-kill nil) ; Last number killed in calc-mode.
(defvar calc-dollar-values nil) ; Values to be used for '$'.
(defvar math-eval-rules-cache-tag t)
(defvar math-radix-explicit-format t)
(defvar math-expr-function-mapping nil)
-(defvar math-expr-special-function-mapping nil)
(defvar math-expr-variable-mapping nil)
(defvar math-read-expr-quotes nil)
(defvar math-working-step nil)
(defvar var-gamma '(special-const (math-gamma-const)))
(defvar var-Modes '(special-const (math-get-modes-vec)))
-(mapcar (lambda (v) (or (boundp v) (set v nil)))
- calc-local-var-list)
+(mapc (lambda (v) (or (boundp v) (set v nil)))
+ calc-local-var-list)
(defvar calc-mode-map
(let ((map (make-keymap)))
(defvar calc-digit-map
(let ((map (make-keymap)))
- (if calc-emacs-type-lucid
+ (if (featurep 'xemacs)
(map-keymap (function
(lambda (keys bind)
(define-key map keys
(if (eq (aref cmap i) 'undefined)
'undefined 'calcDigit-nondigit))
(setq i (1+ i)))))
- (mapcar (lambda (x) (define-key map (char-to-string x) 'calcDigit-key))
- "_0123456789.e+-:n#@oh'\"mspM")
- (mapcar (lambda (x) (define-key map (char-to-string x) 'calcDigit-letter))
+ (mapc (lambda (x) (define-key map (char-to-string x) 'calcDigit-key))
+ "_0123456789.e+-:n#@oh'\"mspM")
+ (mapc (lambda (x) (define-key map (char-to-string x) 'calcDigit-letter))
"abcdfgijklqrtuvwxyzABCDEFGHIJKLNOPQRSTUVWXYZ")
(define-key map "'" 'calcDigit-algebraic)
(define-key map "`" 'calcDigit-edit)
(define-key map "\C-g" 'abort-recursive-edit)
map))
-(mapcar (lambda (x)
- (condition-case err
- (progn
- (define-key calc-digit-map x 'calcDigit-backspace)
- (define-key calc-mode-map x 'calc-pop)
- (define-key calc-mode-map
- (if (vectorp x)
- (if calc-emacs-type-lucid
- (if (= (length x) 1)
- (vector (if (consp (aref x 0))
- (cons 'meta (aref x 0))
- (list 'meta (aref x 0))))
- "\e\C-d")
- (vconcat "\e" x))
- (concat "\e" x))
- 'calc-pop-above))
- (error nil)))
- (if calc-scan-for-dels
- (append (where-is-internal 'delete-backward-char global-map)
- (where-is-internal 'backward-delete-char global-map)
- '("\C-d"))
- '("\177" "\C-d")))
+(mapc (lambda (x)
+ (condition-case err
+ (progn
+ (define-key calc-digit-map x 'calcDigit-backspace)
+ (define-key calc-mode-map x 'calc-pop)
+ (define-key calc-mode-map
+ (if (vectorp x)
+ (if (featurep 'xemacs)
+ (if (= (length x) 1)
+ (vector (if (consp (aref x 0))
+ (cons 'meta (aref x 0))
+ (list 'meta (aref x 0))))
+ "\e\C-d")
+ (vconcat "\e" x))
+ (concat "\e" x))
+ 'calc-pop-above))
+ (error nil)))
+ (if calc-scan-for-dels
+ (append (where-is-internal 'delete-backward-char global-map)
+ (where-is-internal 'backward-delete-char global-map)
+ (where-is-internal 'backward-delete-char-untabify global-map)
+ '("\C-d"))
+ '("\177" "\C-d")))
(defvar calc-dispatch-map
(let ((map (make-keymap)))
- (mapcar (lambda (x)
- (define-key map (char-to-string (car x)) (cdr x))
- (when (string-match "abcdefhijklnopqrstuwxyz"
- (char-to-string (car x)))
- (define-key map (char-to-string (- (car x) ?a -1)) (cdr x)))
- (define-key map (format "\e%c" (car x)) (cdr x)))
- '( ( ?a . calc-embedded-activate )
- ( ?b . calc-big-or-small )
- ( ?c . calc )
- ( ?d . calc-embedded-duplicate )
- ( ?e . calc-embedded )
- ( ?f . calc-embedded-new-formula )
- ( ?g . calc-grab-region )
- ( ?h . calc-dispatch-help )
- ( ?i . calc-info )
- ( ?j . calc-embedded-select )
- ( ?k . calc-keypad )
- ( ?l . calc-load-everything )
- ( ?m . read-kbd-macro )
- ( ?n . calc-embedded-next )
- ( ?o . calc-other-window )
- ( ?p . calc-embedded-previous )
- ( ?q . quick-calc )
- ( ?r . calc-grab-rectangle )
- ( ?s . calc-info-summary )
- ( ?t . calc-tutorial )
- ( ?u . calc-embedded-update-formula )
- ( ?w . calc-embedded-word )
- ( ?x . calc-quit )
- ( ?y . calc-copy-to-buffer )
- ( ?z . calc-user-invocation )
- ( ?\' . calc-embedded-new-formula )
- ( ?\` . calc-embedded-edit )
- ( ?: . calc-grab-sum-down )
- ( ?_ . calc-grab-sum-across )
- ( ?0 . calc-reset )
- ( ?? . calc-dispatch-help )
- ( ?# . calc-same-interface )
- ( ?& . calc-same-interface )
- ( ?\\ . calc-same-interface )
- ( ?= . calc-same-interface )
- ( ?* . calc-same-interface )
- ( ?/ . calc-same-interface )
- ( ?+ . calc-same-interface )
- ( ?- . calc-same-interface ) ))
+ (mapc (lambda (x)
+ (define-key map (char-to-string (car x)) (cdr x))
+ (when (string-match "abcdefhijklnopqrstuwxyz"
+ (char-to-string (car x)))
+ (define-key map (char-to-string (- (car x) ?a -1)) (cdr x)))
+ (define-key map (format "\e%c" (car x)) (cdr x)))
+ '( ( ?a . calc-embedded-activate )
+ ( ?b . calc-big-or-small )
+ ( ?c . calc )
+ ( ?d . calc-embedded-duplicate )
+ ( ?e . calc-embedded )
+ ( ?f . calc-embedded-new-formula )
+ ( ?g . calc-grab-region )
+ ( ?h . calc-dispatch-help )
+ ( ?i . calc-info )
+ ( ?j . calc-embedded-select )
+ ( ?k . calc-keypad )
+ ( ?l . calc-load-everything )
+ ( ?m . read-kbd-macro )
+ ( ?n . calc-embedded-next )
+ ( ?o . calc-other-window )
+ ( ?p . calc-embedded-previous )
+ ( ?q . quick-calc )
+ ( ?r . calc-grab-rectangle )
+ ( ?s . calc-info-summary )
+ ( ?t . calc-tutorial )
+ ( ?u . calc-embedded-update-formula )
+ ( ?w . calc-embedded-word )
+ ( ?x . calc-quit )
+ ( ?y . calc-copy-to-buffer )
+ ( ?z . calc-user-invocation )
+ ( ?\' . calc-embedded-new-formula )
+ ( ?\` . calc-embedded-edit )
+ ( ?: . calc-grab-sum-down )
+ ( ?_ . calc-grab-sum-across )
+ ( ?0 . calc-reset )
+ ( ?? . calc-dispatch-help )
+ ( ?# . calc-same-interface )
+ ( ?& . calc-same-interface )
+ ( ?\\ . calc-same-interface )
+ ( ?= . calc-same-interface )
+ ( ?* . calc-same-interface )
+ ( ?/ . calc-same-interface )
+ ( ?+ . calc-same-interface )
+ ( ?- . calc-same-interface ) ))
map))
;;;; (Autoloads here)
-(mapcar
+(mapc
(lambda (x) (dolist (func (cdr x)) (autoload func (car x))))
'(
("calc-embed" calc-do-embedded-activate)
- ("calc-misc"
+ ("calc-misc"
calc-do-handle-whys calc-do-refresh calc-num-prefix-name
calc-record-list calc-record-why calc-report-bug calc-roll-down-stack
calc-roll-up-stack calc-temp-minibuffer-message calcFunc-floor
math-negp math-posp math-pow math-read-radix-digit math-reject-arg
math-trunc math-zerop)))
-(mapcar
+(mapc
(lambda (x) (dolist (cmd (cdr x)) (autoload cmd (car x) nil t)))
'(
calcDigit-algebraic calcDigit-edit)
("calc-misc" another-calc calc-big-or-small calc-dispatch-help
- calc-help calc-info calc-info-goto-node calc-info-summary calc-inv
+ calc-help calc-info calc-info-goto-node calc-info-summary calc-inv
calc-last-args-stub
calc-missing-key calc-mod calc-other-window calc-over calc-percent
calc-pop-above calc-power calc-roll-down calc-roll-up
(let ((prompt2 (format "%s " (key-description (this-command-keys))))
(glob (current-global-map))
(loc (current-local-map)))
- (or (input-pending-p) (message prompt))
+ (or (input-pending-p) (message "%s" prompt))
(let ((key (calc-read-key t)))
(calc-unread-command (cdr key))
(unwind-protect
(defun calc-version ()
"Return version of this version of Calc."
(interactive)
- (message (concat "Calc version " calc-version)))
+ (message "Calc version %s" calc-version))
(defun calc-mode ()
"Calculator major mode.
\\{calc-mode-map}
"
(interactive)
- (mapcar (function
- (lambda (v) (set-default v (symbol-value v)))) calc-local-var-list)
+ (mapc (function
+ (lambda (v) (set-default v (symbol-value v)))) calc-local-var-list)
(kill-all-local-variables)
(use-local-map (if (eq calc-algebraic-mode 'total)
(progn (require 'calc-ext) calc-alg-map) calc-mode-map))
- (mapcar (function (lambda (v) (make-local-variable v))) calc-local-var-list)
+ (mapc (function (lambda (v) (make-local-variable v))) calc-local-var-list)
(make-local-variable 'overlay-arrow-position)
(make-local-variable 'overlay-arrow-string)
(add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
(string-match "full" (nth 1 p))
(setq calc-standalone-flag t))
(setq p (cdr p))))
+ (require 'calc-menu)
(run-mode-hooks 'calc-mode-hook)
(calc-refresh t)
(calc-set-mode-line)
(calc-create-buffer))
(run-hooks 'calc-end-hook)
(setq calc-undo-list nil calc-redo-list nil)
- (mapcar (function (lambda (v) (set-default v (symbol-value v))))
- calc-local-var-list)
+ (mapc (function (lambda (v) (set-default v (symbol-value v))))
+ calc-local-var-list)
(let ((buf (current-buffer))
(win (get-buffer-window (current-buffer)))
(kbuf (get-buffer "*Calc Keypad*")))
(calc-prev-char nil)
(calc-prev-prev-char nil)
(calc-buffer (current-buffer))
- (buf (if calc-emacs-type-lucid
+ (buf (if (featurep 'xemacs)
(catch 'calc-foo
(catch 'execute-kbd-macro
(throw 'calc-foo
(read-from-minibuffer
"Calc: " "" calc-digit-map)))
- (error "Lucid Emacs requires RET after %s"
+ (error "XEmacs requires RET after %s"
"digit entry in kbd macro"))
(let ((old-esc (lookup-key global-map "\e")))
(unwind-protect
+(defconst math-bignum-digit-length
+ (truncate (/ (log10 (/ most-positive-fixnum 2)) 2))
+ "The length of a \"digit\" in Calc bignums.
+If a big integer is of the form (bigpos N0 N1 ...), this is the
+length of the allowable Emacs integers N0, N1,...
+The value of 2*10^(2*MATH-BIGNUM-DIGIT-LENGTH) must be less than the
+largest Emacs integer.")
+
+(defconst math-bignum-digit-size
+ (expt 10 math-bignum-digit-length)
+ "An upper bound for the size of the \"digit\"s in Calc bignums.")
+(defconst math-small-integer-size
+ (expt math-bignum-digit-size 2)
+ "An upper bound for the size of \"small integer\"s in Calc.")
;;;; Arithmetic routines.
;;; following forms:
;;;
;;; integer An integer. For normalized numbers, this format
-;;; is used only for -999999 ... 999999.
+;;; is used only for
+;;; negative math-small-integer-size + 1 to
+;;; math-small-integer-size - 1
;;;
-;;; (bigpos N0 N1 N2 ...) A big positive integer, N0 + N1*1000 + N2*10^6 ...
-;;; (bigneg N0 N1 N2 ...) A big negative integer, - N0 - N1*1000 ...
-;;; Each digit N is in the range 0 ... 999.
+;;; (bigpos N0 N1 N2 ...) A big positive integer,
+;;; N0 + N1*math-bignum-digit-size
+;;; + N2*(math-bignum-digit-size)^2 ...
+;;; (bigneg N0 N1 N2 ...) A big negative integer,
+;;; - N0 - N1*math-bignum-digit-size ...
+;;; Each digit N is in the range
+;;; 0 ... math-bignum-digit-size -1.
;;; Normalized, always at least three N present,
;;; and the most significant N is nonzero.
;;;
(cond
((not (consp math-normalize-a))
(if (integerp math-normalize-a)
- (if (or (>= math-normalize-a 1000000) (<= math-normalize-a -1000000))
+ (if (or (>= math-normalize-a math-small-integer-size)
+ (<= math-normalize-a (- math-small-integer-size)))
(math-bignum math-normalize-a)
math-normalize-a)
math-normalize-a))
((eq (car math-normalize-a) 'bigpos)
(if (eq (nth (1- (length math-normalize-a)) math-normalize-a) 0)
- (let* ((last (setq math-normalize-a
+ (let* ((last (setq math-normalize-a
(copy-sequence math-normalize-a))) (digs math-normalize-a))
(while (setq digs (cdr digs))
(or (eq (car digs) 0) (setq last digs)))
(if (cdr (cdr (cdr math-normalize-a)))
math-normalize-a
(cond
- ((cdr (cdr math-normalize-a)) (+ (nth 1 math-normalize-a)
- (* (nth 2 math-normalize-a) 1000)))
+ ((cdr (cdr math-normalize-a)) (+ (nth 1 math-normalize-a)
+ (* (nth 2 math-normalize-a)
+ math-bignum-digit-size)))
((cdr math-normalize-a) (nth 1 math-normalize-a))
(t 0))))
((eq (car math-normalize-a) 'bigneg)
(if (eq (nth (1- (length math-normalize-a)) math-normalize-a) 0)
- (let* ((last (setq math-normalize-a (copy-sequence math-normalize-a)))
+ (let* ((last (setq math-normalize-a (copy-sequence math-normalize-a)))
(digs math-normalize-a))
(while (setq digs (cdr digs))
(or (eq (car digs) 0) (setq last digs)))
(if (cdr (cdr (cdr math-normalize-a)))
math-normalize-a
(cond
- ((cdr (cdr math-normalize-a)) (- (+ (nth 1 math-normalize-a)
- (* (nth 2 math-normalize-a) 1000))))
+ ((cdr (cdr math-normalize-a)) (- (+ (nth 1 math-normalize-a)
+ (* (nth 2 math-normalize-a)
+ math-bignum-digit-size))))
((cdr math-normalize-a) (- (nth 1 math-normalize-a)))
(t 0))))
((eq (car math-normalize-a) 'float)
- (math-make-float (math-normalize (nth 1 math-normalize-a))
+ (math-make-float (math-normalize (nth 1 math-normalize-a))
(nth 2 math-normalize-a)))
- ((or (memq (car math-normalize-a)
+ ((or (memq (car math-normalize-a)
'(frac cplx polar hms date mod sdev intv vec var quote
special-const calcFunc-if calcFunc-lambda
calcFunc-quote calcFunc-condition
calcFunc-evalto))
(integerp (car math-normalize-a))
- (and (consp (car math-normalize-a))
+ (and (consp (car math-normalize-a))
(not (eq (car (car math-normalize-a)) 'lambda))))
(require 'calc-ext)
(math-normalize-fancy math-normalize-a))
(math-normalize-nonstandard))
(let ((args (mapcar 'math-normalize (cdr math-normalize-a))))
(or (condition-case err
- (let ((func
+ (let ((func
(assq (car math-normalize-a) '( ( + . math-add )
( - . math-sub )
( * . math-mul )
(require 'calc-ext)
(math-recompile-eval-rules)))
(and (or math-eval-rules-cache-other
- (assq (car math-normalize-a)
+ (assq (car math-normalize-a)
math-eval-rules-cache))
(math-apply-rewrites
(cons (car math-normalize-a) args)
(cons (car math-normalize-a) args))
nil)
(wrong-type-argument
- (or calc-next-why
+ (or calc-next-why
(calc-record-why "Wrong type of argument"
(cons (car math-normalize-a) args)))
nil)
(args-out-of-range
- (calc-record-why "*Argument out of range"
+ (calc-record-why "*Argument out of range"
(cons (car math-normalize-a) args))
nil)
(inexact-result
(defun math-bignum-big (a) ; [L s]
(if (= a 0)
nil
- (cons (% a 1000) (math-bignum-big (/ a 1000)))))
+ (cons (% a math-bignum-digit-size)
+ (math-bignum-big (/ a math-bignum-digit-size)))))
;;; Build a normalized floating-point number. [F I S]
(progn
(while (= (car digs) 0)
(setq digs (cdr digs)
- exp (+ exp 3)))
+ exp (+ exp math-bignum-digit-length)))
(while (= (% (car digs) 10) 0)
(setq digs (math-div10-bignum digs)
exp (1+ exp)))
(defun math-div10-bignum (a) ; [l l]
(if (cdr a)
- (cons (+ (/ (car a) 10) (* (% (nth 1 a) 10) 100))
+ (cons (+ (/ (car a) 10) (* (% (nth 1 a) 10)
+ (expt 10 (1- math-bignum-digit-length))))
(math-div10-bignum (cdr a)))
(list (/ (car a) 10))))
(if (cdr a)
(let* ((len (1- (length a)))
(top (nth len a)))
- (+ (* len 3) (cond ((>= top 100) 0) ((>= top 10) -1) (t -2))))
+ (+ (* (1- len) math-bignum-digit-length) (math-numdigs top)))
0)
(cond ((>= a 100) (+ (math-numdigs (/ a 1000)) 3))
((>= a 10) 2)
a
(if (consp a)
(cons (car a) (math-scale-left-bignum (cdr a) n))
- (if (>= n 3)
- (if (or (>= a 1000) (<= a -1000))
+ (if (>= n math-bignum-digit-length)
+ (if (or (>= a math-bignum-digit-size)
+ (<= a (- math-bignum-digit-size)))
(math-scale-left (math-bignum a) n)
- (math-scale-left (* a 1000) (- n 3)))
- (if (= n 2)
- (if (or (>= a 10000) (<= a -10000))
- (math-scale-left (math-bignum a) 2)
- (* a 100))
- (if (or (>= a 100000) (<= a -100000))
- (math-scale-left (math-bignum a) 1)
- (* a 10)))))))
+ (math-scale-left (* a math-bignum-digit-size)
+ (- n math-bignum-digit-length)))
+ (let ((sz (expt 10 (- (* 2 math-bignum-digit-length) n))))
+ (if (or (>= a sz) (<= a (- sz)))
+ (math-scale-left (math-bignum a) n)
+ (* a (expt 10 n))))))))
(defun math-scale-left-bignum (a n)
- (if (>= n 3)
+ (if (>= n math-bignum-digit-length)
(while (>= (setq a (cons 0 a)
- n (- n 3)) 3)))
+ n (- n math-bignum-digit-length))
+ math-bignum-digit-length)))
(if (> n 0)
- (math-mul-bignum-digit a (if (= n 2) 100 10) 0)
+ (math-mul-bignum-digit a (expt 10 n) 0)
a))
(defun math-scale-right (a n) ; [i i S]
(if (= a 0)
0
(- (math-scale-right (- a) n)))
- (if (>= n 3)
- (while (and (> (setq a (/ a 1000)) 0)
- (>= (setq n (- n 3)) 3))))
- (if (= n 2)
- (/ a 100)
- (if (= n 1)
- (/ a 10)
- a))))))
+ (if (>= n math-bignum-digit-length)
+ (while (and (> (setq a (/ a math-bignum-digit-size)) 0)
+ (>= (setq n (- n math-bignum-digit-length))
+ math-bignum-digit-length))))
+ (if (> n 0)
+ (/ a (expt 10 n))
+ a)))))
(defun math-scale-right-bignum (a n) ; [L L S; l l S]
- (if (>= n 3)
- (setq a (nthcdr (/ n 3) a)
- n (% n 3)))
+ (if (>= n math-bignum-digit-length)
+ (setq a (nthcdr (/ n math-bignum-digit-length) a)
+ n (% n math-bignum-digit-length)))
(if (> n 0)
- (cdr (math-mul-bignum-digit a (if (= n 2) 10 100) 0))
+ (cdr (math-mul-bignum-digit a (expt 10 (- math-bignum-digit-length n)) 0))
a))
;;; Multiply (with rounding) the integer A by 10^N. [I i S]
((consp a)
(math-normalize
(cons (car a)
- (let ((val (if (< n -3)
- (math-scale-right-bignum (cdr a) (- -3 n))
- (if (= n -2)
- (math-mul-bignum-digit (cdr a) 10 0)
- (if (= n -1)
- (math-mul-bignum-digit (cdr a) 100 0)
- (cdr a)))))) ; n = -3
- (if (and val (>= (car val) 500))
+ (let ((val (if (< n (- math-bignum-digit-length))
+ (math-scale-right-bignum
+ (cdr a)
+ (- (- math-bignum-digit-length) n))
+ (if (< n 0)
+ (math-mul-bignum-digit
+ (cdr a)
+ (expt 10 (+ math-bignum-digit-length n)) 0)
+ (cdr a))))) ; n = -math-bignum-digit-length
+ (if (and val (>= (car val) (/ math-bignum-digit-size 2)))
(if (cdr val)
- (if (eq (car (cdr val)) 999)
+ (if (eq (car (cdr val)) (1- math-bignum-digit-size))
(math-add-bignum (cdr val) '(1))
(cons (1+ (car (cdr val))) (cdr (cdr val))))
'(1))
(and (not (or (consp a) (consp b)))
(progn
(setq a (+ a b))
- (if (or (<= a -1000000) (>= a 1000000))
+ (if (or (<= a (- math-small-integer-size)) (>= a math-small-integer-size))
(math-bignum a)
a)))
(and (Math-zerop a) (not (eq (car-safe a) 'mod))
(let* ((a (copy-sequence a)) (aa a) (carry nil) sum)
(while (and aa b)
(if carry
- (if (< (setq sum (+ (car aa) (car b))) 999)
+ (if (< (setq sum (+ (car aa) (car b)))
+ (1- math-bignum-digit-size))
(progn
(setcar aa (1+ sum))
(setq carry nil))
- (setcar aa (+ sum -999)))
- (if (< (setq sum (+ (car aa) (car b))) 1000)
+ (setcar aa (- sum (1- math-bignum-digit-size))))
+ (if (< (setq sum (+ (car aa) (car b))) math-bignum-digit-size)
(setcar aa sum)
- (setcar aa (+ sum -1000))
+ (setcar aa (- sum math-bignum-digit-size))
(setq carry t)))
(setq aa (cdr aa)
b (cdr b)))
(if carry
(if b
(nconc a (math-add-bignum b '(1)))
- (while (eq (car aa) 999)
+ (while (eq (car aa) (1- math-bignum-digit-size))
(setcar aa 0)
(setq aa (cdr aa)))
(if aa
(progn
(setcar aa (1- diff))
(setq borrow nil))
- (setcar aa (+ diff 999)))
+ (setcar aa (+ diff (1- math-bignum-digit-size))))
(if (>= (setq diff (- (car aa) (car b))) 0)
(setcar aa diff)
- (setcar aa (+ diff 1000))
+ (setcar aa (+ diff math-bignum-digit-size))
(setq borrow t)))
(setq aa (cdr aa)
b (cdr b)))
(if borrow
(progn
(while (eq (car aa) 0)
- (setcar aa 999)
+ (setcar aa (1- math-bignum-digit-size))
(setq aa (cdr aa)))
(if aa
(progn
(if (or (consp a) (consp b))
(math-add a (math-neg b))
(setq a (- a b))
- (if (or (<= a -1000000) (>= a 1000000))
+ (if (or (<= a (- math-small-integer-size)) (>= a math-small-integer-size))
(math-bignum a)
a)))
(defun math-mul (a b)
(or
(and (not (consp a)) (not (consp b))
- (< a 1000) (> a -1000) (< b 1000) (> b -1000)
+ (< a math-bignum-digit-size) (> a (- math-bignum-digit-size))
+ (< b math-bignum-digit-size) (> b (- math-bignum-digit-size))
(* a b))
(and (Math-zerop a) (not (eq (car-safe b) 'mod))
(if (Math-scalarp b)
aa a)
(while (progn
(setcar ss (% (setq prod (+ (+ (car ss) (* (car aa) d))
- c)) 1000))
+ c)) math-bignum-digit-size))
(setq aa (cdr aa)))
- (setq c (/ prod 1000)
+ (setq c (/ prod math-bignum-digit-size)
ss (or (cdr ss) (setcdr ss (list 0)))))
- (if (>= prod 1000)
+ (if (>= prod math-bignum-digit-size)
(if (cdr ss)
- (setcar (cdr ss) (+ (/ prod 1000) (car (cdr ss))))
- (setcdr ss (list (/ prod 1000))))))
+ (setcar (cdr ss) (+ (/ prod math-bignum-digit-size) (car (cdr ss))))
+ (setcdr ss (list (/ prod math-bignum-digit-size))))))
sum)))
;;; Multiply digit list A by digit D. [L L D D; l l D D]
(and (= d 1) a)
(let* ((a (copy-sequence a)) (aa a) prod)
(while (progn
- (setcar aa (% (setq prod (+ (* (car aa) d) c)) 1000))
+ (setcar aa
+ (% (setq prod (+ (* (car aa) d) c))
+ math-bignum-digit-size))
(cdr aa))
(setq aa (cdr aa)
- c (/ prod 1000)))
- (if (>= prod 1000)
- (setcdr aa (list (/ prod 1000))))
+ c (/ prod math-bignum-digit-size)))
+ (if (>= prod math-bignum-digit-size)
+ (setcdr aa (list (/ prod math-bignum-digit-size))))
a))
(and (> c 0)
(list c))))
(if (eq b 0)
(math-reject-arg a "*Division by zero"))
(if (or (consp a) (consp b))
- (if (and (natnump b) (< b 1000))
+ (if (and (natnump b) (< b math-bignum-digit-size))
(let ((res (math-div-bignum-digit (cdr a) b)))
(cons
(math-normalize (cons (car a) (car res)))
(if (= b 0)
(math-reject-arg a "*Division by zero")
(/ a b))
- (if (and (natnump b) (< b 1000))
+ (if (and (natnump b) (< b math-bignum-digit-size))
(if (= b 0)
(math-reject-arg a "*Division by zero")
(math-normalize (cons (car a)
(or (consp b) (setq b (math-bignum b)))
(let* ((alen (1- (length a)))
(blen (1- (length b)))
- (d (/ 1000 (1+ (nth (1- blen) (cdr b)))))
+ (d (/ math-bignum-digit-size (1+ (nth (1- blen) (cdr b)))))
(res (math-div-bignum-big (math-mul-bignum-digit (cdr a) d 0)
(math-mul-bignum-digit (cdr b) d 0)
alen blen)))
(if (cdr b)
(let* ((alen (length a))
(blen (length b))
- (d (/ 1000 (1+ (nth (1- blen) b))))
+ (d (/ math-bignum-digit-size (1+ (nth (1- blen) b))))
(res (math-div-bignum-big (math-mul-bignum-digit a d 0)
(math-mul-bignum-digit b d 0)
alen blen)))
(defun math-div-bignum-digit (a b)
(if a
(let* ((res (math-div-bignum-digit (cdr a) b))
- (num (+ (* (cdr res) 1000) (car a))))
+ (num (+ (* (cdr res) math-bignum-digit-size) (car a))))
(cons
(cons (/ num b) (car res))
(% num b)))
(cons (car res2) (car res))
(cdr res2)))))
-(defun math-div-bignum-part (a b blen) ; a < b*1000 [D.l l L]
- (let* ((num (+ (* (or (nth blen a) 0) 1000) (or (nth (1- blen) a) 0)))
+(defun math-div-bignum-part (a b blen) ; a < b*math-bignum-digit-size [D.l l L]
+ (let* ((num (+ (* (or (nth blen a) 0) math-bignum-digit-size)
+ (or (nth (1- blen) a) 0)))
(den (nth (1- blen) b))
- (guess (min (/ num den) 999)))
+ (guess (min (/ num den) (1- math-bignum-digit-size))))
(math-div-bignum-try a b (math-mul-bignum-digit b guess 0) guess)))
(defun math-div-bignum-try (a b c guess) ; [D.l l l D]
(if a
(let ((s ""))
(while (cdr (cdr a))
- (setq s (concat (format "%06d" (+ (* (nth 1 a) 1000) (car a))) s)
+ (setq s (concat
+ (format
+ (concat "%0"
+ (number-to-string (* 2 math-bignum-digit-length))
+ "d")
+ (+ (* (nth 1 a) math-bignum-digit-size) (car a))) s)
a (cdr (cdr a))))
- (concat (int-to-string (+ (* (or (nth 1 a) 0) 1000) (car a))) s))
+ (concat (int-to-string
+ (+ (* (or (nth 1 a) 0) math-bignum-digit-size) (car a))) s))
"0"))
;;; Parse a simple number in string form. [N X] [Public]
(defun math-read-number (s)
+ "Convert the string S into a Calc number."
(math-normalize
(cond
(> (length digs) 1)
(eq (aref digs 0) ?0))
(math-read-number (concat "8#" digs))
- (if (<= (length digs) 6)
+ (if (<= (length digs) (* 2 math-bignum-digit-length))
(string-to-number digs)
(cons 'bigpos (math-read-bignum digs))))))
;; Syntax error!
(t nil))))
+;;; Parse a very simple number, keeping all digits.
+(defun math-read-number-simple (s)
+ "Convert the string S into a Calc number.
+S is assumed to be a simple number (integer or float without an exponent)
+and all digits are kept, regardless of Calc's current precision."
+ (cond
+ ;; Integer
+ ((string-match "^[0-9]+$" s)
+ (if (string-match "^\\(0+\\)" s)
+ (setq s (substring s (match-end 0))))
+ (if (<= (length s) (* 2 math-bignum-digit-length))
+ (string-to-number s)
+ (cons 'bigpos (math-read-bignum s))))
+ ;; Minus sign
+ ((string-match "^-[0-9]+$" s)
+ (if (<= (length s) (1+ (* 2 math-bignum-digit-length)))
+ (string-to-number s)
+ (cons 'bigneg (math-read-bignum (substring s 1)))))
+ ;; Decimal point
+ ((string-match "^\\(-?[0-9]*\\)\\.\\([0-9]*\\)$" s)
+ (let ((int (math-match-substring s 1))
+ (frac (math-match-substring s 2)))
+ (list 'float (math-read-number-simple (concat int frac))
+ (- (length frac)))))
+ ;; Syntax error!
+ (t nil)))
+
(defun math-match-substring (s n)
(if (match-beginning n)
(substring s (match-beginning n) (match-end n))
""))
(defun math-read-bignum (s) ; [l X]
- (if (> (length s) 3)
- (cons (string-to-number (substring s -3))
- (math-read-bignum (substring s 0 -3)))
+ (if (> (length s) math-bignum-digit-length)
+ (cons (string-to-number (substring s (- math-bignum-digit-length)))
+ (math-read-bignum (substring s 0 (- math-bignum-digit-length))))
(list (string-to-number s))))
-
-(defconst math-tex-ignore-words
- '( ("\\hbox") ("\\mbox") ("\\text") ("\\left") ("\\right")
- ("\\,") ("\\>") ("\\:") ("\\;") ("\\!") ("\\ ")
- ("\\quad") ("\\qquad") ("\\hfil") ("\\hfill")
- ("\\displaystyle") ("\\textstyle") ("\\dsize") ("\\tsize")
- ("\\scriptstyle") ("\\scriptscriptstyle") ("\\ssize") ("\\sssize")
- ("\\rm") ("\\bf") ("\\it") ("\\sl")
- ("\\roman") ("\\bold") ("\\italic") ("\\slanted")
- ("\\cal") ("\\mit") ("\\Cal") ("\\Bbb") ("\\frak") ("\\goth")
- ("\\evalto")
- ("\\matrix" mat) ("\\bmatrix" mat) ("\\pmatrix" mat)
- ("\\begin" begenv)
- ("\\cr" punc ";") ("\\\\" punc ";") ("\\*" punc "*")
- ("\\{" punc "[") ("\\}" punc "]")))
-
-(defconst math-latex-ignore-words
- (append math-tex-ignore-words
- '(("\\begin" begenv))))
-
-(defconst math-eqn-ignore-words
- '( ("roman") ("bold") ("italic") ("mark") ("lineup") ("evalto")
- ("left" ("floor") ("ceil"))
- ("right" ("floor") ("ceil"))
- ("arc" ("sin") ("cos") ("tan") ("sinh") ("cosh") ("tanh"))
- ("size" n) ("font" n) ("fwd" n) ("back" n) ("up" n) ("down" n)
- ("above" punc ",")))
-
(defconst math-standard-opers
'( ( "_" calcFunc-subscr 1200 1201 )
( "%" calcFunc-percent 1100 -1 )
- ( "u+" ident -1 1000 )
- ( "u-" neg -1 1000 197 )
( "u!" calcFunc-lnot -1 1000 )
( "mod" mod 400 400 185 )
( "+/-" sdev 300 300 185 )
( "!" calcFunc-fact 210 -1 )
( "^" ^ 201 200 )
( "**" ^ 201 200 )
+ ( "u+" ident -1 197 )
+ ( "u-" neg -1 197 )
( "/" / 190 191 )
( "%" % 190 191 )
( "\\" calcFunc-idiv 190 191 )
'( "2x" * 190 191 )
math-standard-opers))))
+(defvar math-expr-opers (math-standard-ops))
+
(defun math-standard-ops-p ()
(let ((meo (caar math-expr-opers)))
(and (stringp meo)
(string= meo "*"))))
-(defvar math-expr-opers (math-standard-ops))
-
(defun math-expr-ops ()
(if (math-standard-ops-p)
(math-standard-ops)
;;; Functions needed for Lucid Emacs support.
(defun calc-read-key (&optional optkey)
- (cond (calc-emacs-type-lucid
+ (cond ((featurep 'xemacs)
(let ((event (next-command-event)))
(let ((key (event-to-character event t t)))
(or key optkey (error "Expected a plain keystroke"))
(defun calc-clear-unread-commands ()
(if (featurep 'xemacs)
- (calc-emacs-type-lucid (setq unread-command-event nil))
+ (setq unread-command-event nil)
(setq unread-command-events nil)))
(when calc-always-load-extensions
HCoop / bpt / emacs.git / blobdiff