* lisp/calc/: Use lexical scoping in all the files
Includes the following pervasive changes: - Move some defvars earlier in the file so they cover earlier let-bindings - Change dynamically scoped `calc-FOO` or `math-FOO` function arguments to just FOO and then let-bind the `calc-FOO` or `math-FOO` variable explicitly in the body of the function. In some cases, the beginning of the function was changed to refer to FOO so as to delay the binding to a nearby `let` when I could ensure that it did not make a difference. - Add an underscore in front of unused vars or comment them out altogether. - Replace unused `err` arg to `condition-case` with nil. Plus the additional itemized changes below. * lisp/calc/calc-map.el (calcFunc-reducer): * lisp/calc/calc-arith.el (math-setup-declarations): * lisp/calc/calc-help.el (calc-full-help, calc-help-index-entries) (calc-full-help): Use `ignore-errors`. * lisp/calc/calc-embed.el (calc-embedded-modes-change): Declare `the-language` and `the-display-just` as dynamically scoped. * lisp/calc/calc-forms.el (math-setup-year-holidays): Use `dolist`. * lisp/calc/calc-graph.el (calc-graph-set-styles): Use `symbol-value` rather than `eval.` (calc-graph-delete-temps, calc-graph-set-styles): Use ignore-errors. * lisp/calc/calc-macs.el (calc-with-trail-buffer): Add artificial use of `save-buf` to silence compiler warnings in all the cases where `body` doesn't make use of it. * lisp/calc/calc-math.el (math-largest-emacs-expt) (math-smallest-emacs-expt, math-use-emacs-fn): Use ignore-errors. * lisp/calc/calc-mode.el (calc-total-algebraic-mode): Remove "P" from interactive spec since it's not used anyway. * lisp/calc/calc-rewr.el (calc-match): Simplify. * lisp/calc/calc.el (calc-buffer): Give it a global nil value, so it's automatically declared dynbound in any file that requires `calc`. (calcDigit-nondigit): Adjust accordingly. * lisp/calc/calcalg2.el (calcFunc-table): Declare `var-dummy` as dynbound. (math-scan-for-limits): Comment out dead code. * lisp/calc/calcalg3.el (math-general-fit): Declare `var-YVAL` and `var-YVALX` as dynbound.
This commit is contained in:
Stefan Monnier
parent
46c0f28c0e
commit
f342b7c969
39 changed files with 528 additions and 465 deletions
|
|
@ -1,4 +1,4 @@
|
|||
;;; calc-aent.el --- algebraic entry functions for Calc
|
||||
;;; calc-aent.el --- algebraic entry functions for Calc -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -158,7 +158,7 @@
|
|||
(setq strp (cdr (cdr strp))))
|
||||
(calc-do-calc-eval (car str) separator args)))
|
||||
((eq separator 'eval)
|
||||
(eval str))
|
||||
(eval str t))
|
||||
((eq separator 'macro)
|
||||
(require 'calc-ext)
|
||||
(let* ((calc-buffer (current-buffer))
|
||||
|
|
@ -285,6 +285,8 @@ The value t means abort and give an error message.")
|
|||
(defvar calc-alg-entry-history nil
|
||||
"History for algebraic entry.")
|
||||
|
||||
(defvar calc-plain-entry nil)
|
||||
|
||||
;;;###autoload
|
||||
(defun calc-alg-entry (&optional initial prompt)
|
||||
(let* ((calc-dollar-values (mapcar #'calc-get-stack-element
|
||||
|
|
@ -401,7 +403,6 @@ The value t means abort and give an error message.")
|
|||
(use-local-map calc-mode-map))
|
||||
(calcAlg-enter))
|
||||
|
||||
(defvar calc-plain-entry nil)
|
||||
(defun calcAlg-edit ()
|
||||
(interactive)
|
||||
(if (or (not calc-plain-entry)
|
||||
|
|
@ -576,8 +577,9 @@ in Calc algebraic input.")
|
|||
(defvar math-expr-data)
|
||||
|
||||
;;;###autoload
|
||||
(defun math-read-exprs (math-exp-str)
|
||||
(let ((math-exp-pos 0)
|
||||
(defun math-read-exprs (str)
|
||||
(let ((math-exp-str str)
|
||||
(math-exp-pos 0)
|
||||
(math-exp-old-pos 0)
|
||||
(math-exp-keep-spaces nil)
|
||||
math-exp-token math-expr-data)
|
||||
|
|
@ -738,8 +740,8 @@ in Calc algebraic input.")
|
|||
math-exp-pos (match-end 0)))
|
||||
((and (setq adfn
|
||||
(assq ch (get calc-language 'math-lang-read-symbol)))
|
||||
(eval (nth 1 adfn)))
|
||||
(eval (nth 2 adfn)))
|
||||
(eval (nth 1 adfn) t))
|
||||
(eval (nth 2 adfn) t))
|
||||
((eq ch ?\$)
|
||||
(if (eq (string-match "\\$\\([1-9][0-9]*\\)" math-exp-str math-exp-pos)
|
||||
math-exp-pos)
|
||||
|
|
@ -771,8 +773,8 @@ in Calc algebraic input.")
|
|||
math-expr-data (math-match-substring math-exp-str 1)
|
||||
math-exp-pos (match-end 0)))
|
||||
((and (setq adfn (get calc-language 'math-lang-read))
|
||||
(eval (nth 0 adfn))
|
||||
(eval (nth 1 adfn))))
|
||||
(eval (nth 0 adfn) t)
|
||||
(eval (nth 1 adfn) t)))
|
||||
((eq (string-match "%%.*$" math-exp-str math-exp-pos) math-exp-pos)
|
||||
(setq math-exp-pos (match-end 0))
|
||||
(math-read-token))
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calc-arith.el --- arithmetic functions for Calc
|
||||
;;; calc-arith.el --- arithmetic functions for Calc -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -250,44 +250,43 @@
|
|||
(while (setq p (cdr p))
|
||||
(and (eq (car-safe (car p)) 'vec)
|
||||
(setq vec (nth 2 (car p)))
|
||||
(condition-case err
|
||||
(let ((v (nth 1 (car p))))
|
||||
(setq type nil range nil)
|
||||
(or (eq (car-safe vec) 'vec)
|
||||
(setq vec (list 'vec vec)))
|
||||
(while (and (setq vec (cdr vec))
|
||||
(not (Math-objectp (car vec))))
|
||||
(and (eq (car-safe (car vec)) 'var)
|
||||
(let ((st (assq (nth 1 (car vec))
|
||||
math-super-types)))
|
||||
(cond (st (setq type (append type st)))
|
||||
((eq (nth 1 (car vec)) 'pos)
|
||||
(setq type (append type
|
||||
'(real number))
|
||||
range
|
||||
'(intv 1 0 (var inf var-inf))))
|
||||
((eq (nth 1 (car vec)) 'nonneg)
|
||||
(setq type (append type
|
||||
'(real number))
|
||||
range
|
||||
'(intv 3 0
|
||||
(var inf var-inf))))))))
|
||||
(if vec
|
||||
(setq type (append type '(real number))
|
||||
range (math-prepare-set (cons 'vec vec))))
|
||||
(setq type (list type range))
|
||||
(or (eq (car-safe v) 'vec)
|
||||
(setq v (list 'vec v)))
|
||||
(while (setq v (cdr v))
|
||||
(if (or (eq (car-safe (car v)) 'var)
|
||||
(not (Math-primp (car v))))
|
||||
(setq math-decls-cache
|
||||
(cons (cons (if (eq (car (car v)) 'var)
|
||||
(nth 2 (car v))
|
||||
(car (car v)))
|
||||
type)
|
||||
math-decls-cache)))))
|
||||
(error nil)))))
|
||||
(ignore-errors
|
||||
(let ((v (nth 1 (car p))))
|
||||
(setq type nil range nil)
|
||||
(or (eq (car-safe vec) 'vec)
|
||||
(setq vec (list 'vec vec)))
|
||||
(while (and (setq vec (cdr vec))
|
||||
(not (Math-objectp (car vec))))
|
||||
(and (eq (car-safe (car vec)) 'var)
|
||||
(let ((st (assq (nth 1 (car vec))
|
||||
math-super-types)))
|
||||
(cond (st (setq type (append type st)))
|
||||
((eq (nth 1 (car vec)) 'pos)
|
||||
(setq type (append type
|
||||
'(real number))
|
||||
range
|
||||
'(intv 1 0 (var inf var-inf))))
|
||||
((eq (nth 1 (car vec)) 'nonneg)
|
||||
(setq type (append type
|
||||
'(real number))
|
||||
range
|
||||
'(intv 3 0
|
||||
(var inf var-inf))))))))
|
||||
(if vec
|
||||
(setq type (append type '(real number))
|
||||
range (math-prepare-set (cons 'vec vec))))
|
||||
(setq type (list type range))
|
||||
(or (eq (car-safe v) 'vec)
|
||||
(setq v (list 'vec v)))
|
||||
(while (setq v (cdr v))
|
||||
(if (or (eq (car-safe (car v)) 'var)
|
||||
(not (Math-primp (car v))))
|
||||
(setq math-decls-cache
|
||||
(cons (cons (if (eq (car (car v)) 'var)
|
||||
(nth 2 (car v))
|
||||
(car (car v)))
|
||||
type)
|
||||
math-decls-cache)))))))))
|
||||
(setq math-decls-all (assq 'var-All math-decls-cache)))))
|
||||
|
||||
(defun math-known-scalarp (a &optional assume-scalar)
|
||||
|
|
@ -2892,7 +2891,7 @@
|
|||
(eq a b))
|
||||
(list 'calcFunc-exp sumpow))
|
||||
(t
|
||||
(condition-case err
|
||||
(condition-case nil
|
||||
(math-pow a sumpow)
|
||||
(inexact-result (list '^ a sumpow)))))))))
|
||||
(and math-simplifying-units
|
||||
|
|
@ -2927,7 +2926,7 @@
|
|||
(math-div 1 (list 'calcFunc-sqrt (math-mul a b))))
|
||||
(t
|
||||
(setq a (math-mul a b))
|
||||
(condition-case err
|
||||
(condition-case nil
|
||||
(math-pow a apow)
|
||||
(inexact-result (list '^ a apow)))))))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calc-bin.el --- binary functions for Calc
|
||||
;;; calc-bin.el --- binary functions for Calc -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calc-comb.el --- combinatoric functions for Calc
|
||||
;;; calc-comb.el --- combinatoric functions for Calc -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calc-cplx.el --- Complex number functions for Calc
|
||||
;;; calc-cplx.el --- Complex number functions for Calc -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calc-embed.el --- embed Calc in a buffer
|
||||
;;; calc-embed.el --- embed Calc in a buffer -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -219,13 +219,17 @@
|
|||
(defvar calc-override-minor-modes
|
||||
(cons t calc-override-minor-modes-map))
|
||||
|
||||
(defun calc-do-embedded (calc-embed-arg end obeg oend)
|
||||
(defvar calc-embedded-no-reselect nil)
|
||||
|
||||
(defun calc-do-embedded (embed-arg end obeg oend)
|
||||
(let ((calc-embed-arg embed-arg))
|
||||
(if calc-embedded-info
|
||||
|
||||
;; Turn embedded mode off or switch to a new buffer.
|
||||
(cond ((eq (current-buffer) (aref calc-embedded-info 1))
|
||||
(let ((calcbuf (current-buffer))
|
||||
(buf (aref calc-embedded-info 0)))
|
||||
;; (buf (aref calc-embedded-info 0))
|
||||
)
|
||||
(calc-embedded-original-buffer t)
|
||||
(calc-embedded nil)
|
||||
(switch-to-buffer calcbuf)))
|
||||
|
|
@ -291,7 +295,7 @@
|
|||
(calc-embedded-info info)
|
||||
(calc-embedded-no-reselect t))
|
||||
(calc-wrapper
|
||||
(let* ((okay nil)
|
||||
(let* (;; (okay nil)
|
||||
(calc-no-refresh-evaltos t))
|
||||
(if (aref info 8)
|
||||
(progn
|
||||
|
|
@ -336,7 +340,7 @@
|
|||
"Type `C-x * x'"
|
||||
"Give this command again")
|
||||
" to return to normal")))))
|
||||
(scroll-down 0)) ; fix a bug which occurs when truncate-lines is changed.
|
||||
(scroll-down 0))) ; fix a bug which occurs when truncate-lines is changed.
|
||||
|
||||
|
||||
(defun calc-embedded-select (arg)
|
||||
|
|
@ -353,9 +357,10 @@
|
|||
(calc-select-part 2)))
|
||||
|
||||
|
||||
(defun calc-embedded-update-formula (calc-embed-arg)
|
||||
(defun calc-embedded-update-formula (embed-arg)
|
||||
(interactive "P")
|
||||
(if calc-embed-arg
|
||||
(let ((calc-embed-arg embed-arg))
|
||||
(if embed-arg
|
||||
(let ((entry (assq (current-buffer) calc-embedded-active)))
|
||||
(while (setq entry (cdr entry))
|
||||
(and (eq (car-safe (aref (car entry) 8)) 'calcFunc-evalto)
|
||||
|
|
@ -376,12 +381,13 @@
|
|||
(progn
|
||||
(save-excursion
|
||||
(calc-embedded-update info 14 'eval t))
|
||||
(goto-char (+ (aref info 4) pt))))))))
|
||||
(goto-char (+ (aref info 4) pt)))))))))
|
||||
|
||||
|
||||
(defun calc-embedded-edit (calc-embed-arg)
|
||||
(defun calc-embedded-edit (embed-arg)
|
||||
(interactive "P")
|
||||
(let ((info (calc-embedded-make-info (point) nil t calc-embed-arg))
|
||||
(let ((calc-embed-arg embed-arg))
|
||||
(let ((info (calc-embedded-make-info (point) nil t embed-arg))
|
||||
str)
|
||||
(if (eq (car-safe (aref info 8)) 'error)
|
||||
(progn
|
||||
|
|
@ -392,15 +398,14 @@
|
|||
(math-format-nice-expr (aref info 8) (frame-width))))
|
||||
(calc-edit-mode (list 'calc-embedded-finish-edit info))
|
||||
(insert str "\n")))
|
||||
(calc-show-edit-buffer))
|
||||
(calc-show-edit-buffer)))
|
||||
|
||||
(defvar calc-original-buffer)
|
||||
(defvar calc-edit-top)
|
||||
(defun calc-embedded-finish-edit (info)
|
||||
(let ((buf (current-buffer))
|
||||
(str (buffer-substring calc-edit-top (point-max)))
|
||||
(start (point))
|
||||
pos)
|
||||
(start (point))) ;; pos
|
||||
(switch-to-buffer calc-original-buffer)
|
||||
(let ((val (with-current-buffer (aref info 1)
|
||||
(let ((calc-language nil)
|
||||
|
|
@ -416,7 +421,8 @@
|
|||
(calc-embedded-update info 14 t t))))
|
||||
|
||||
;;;###autoload
|
||||
(defun calc-do-embedded-activate (calc-embed-arg cbuf)
|
||||
(defun calc-do-embedded-activate (embed-arg cbuf)
|
||||
(let ((calc-embed-arg embed-arg))
|
||||
(calc-plain-buffer-only)
|
||||
(if calc-embed-arg
|
||||
(calc-embedded-forget))
|
||||
|
|
@ -443,7 +449,7 @@
|
|||
(or (eq (car-safe (aref info 8)) 'error)
|
||||
(goto-char (aref info 5))))))
|
||||
(message "Activating %s for Calc Embedded mode...done" (buffer-name)))
|
||||
(calc-embedded-active-state t))
|
||||
(calc-embedded-active-state t)))
|
||||
|
||||
(defun calc-plain-buffer-only ()
|
||||
(if (memq major-mode '(calc-mode calc-trail-mode calc-edit-mode))
|
||||
|
|
@ -735,13 +741,13 @@ The command \\[yank] can retrieve it from there."
|
|||
|
||||
(defun calc-find-globals ()
|
||||
(interactive)
|
||||
(and (eq major-mode 'calc-mode)
|
||||
(and (derived-mode-p 'calc-mode)
|
||||
(error "This command should be used in a normal editing buffer"))
|
||||
(make-local-variable 'calc-embedded-globals)
|
||||
(let ((case-fold-search nil)
|
||||
(modes nil)
|
||||
(save-pt (point))
|
||||
found value)
|
||||
found) ;; value
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "\\[calc-global-mode: *\\([-a-z]+\\): *\\(\"\\([^\"\n\\]\\|\\\\.\\)*\"\\|[- ()a-zA-Z0-9]+\\)\\]" nil t)
|
||||
(and (setq found (assoc (buffer-substring (match-beginning 1)
|
||||
|
|
@ -764,7 +770,7 @@ The command \\[yank] can retrieve it from there."
|
|||
(modes nil)
|
||||
(emodes nil)
|
||||
(pmodes nil)
|
||||
found value)
|
||||
found) ;; value
|
||||
(while (and no-defaults (search-backward "[calc-" nil t))
|
||||
(forward-char 6)
|
||||
(or (and (looking-at "mode: *\\([-a-z]+\\): *\\(\"\\([^\"\n\\]\\|\\\\.\\)*\"\\|[- ()a-zA-Z0-9]+\\)]")
|
||||
|
|
@ -817,9 +823,13 @@ The command \\[yank] can retrieve it from there."
|
|||
(defvar calc-embed-vars-used)
|
||||
|
||||
(defun calc-embedded-make-info (point cbuf fresh &optional
|
||||
calc-embed-top calc-embed-bot
|
||||
calc-embed-outer-top calc-embed-outer-bot)
|
||||
(let* ((bufentry (assq (current-buffer) calc-embedded-active))
|
||||
embed-top embed-bot
|
||||
embed-outer-top embed-outer-bot)
|
||||
(let* ((calc-embed-top embed-top)
|
||||
(calc-embed-bot embed-bot)
|
||||
(calc-embed-outer-top embed-outer-top)
|
||||
(calc-embed-outer-bot embed-outer-bot)
|
||||
(bufentry (assq (current-buffer) calc-embedded-active))
|
||||
(found bufentry)
|
||||
(force (and fresh calc-embed-top (null (equal calc-embed-top '(t)))))
|
||||
(fixed calc-embed-top)
|
||||
|
|
@ -1175,7 +1185,6 @@ The command \\[yank] can retrieve it from there."
|
|||
|
||||
;;; These are hooks called by the main part of Calc.
|
||||
|
||||
(defvar calc-embedded-no-reselect nil)
|
||||
(defun calc-embedded-select-buffer ()
|
||||
(if (eq (current-buffer) (aref calc-embedded-info 0))
|
||||
(let ((info calc-embedded-info)
|
||||
|
|
@ -1240,7 +1249,7 @@ The command \\[yank] can retrieve it from there."
|
|||
(with-current-buffer (aref calc-embedded-info 1)
|
||||
(let* ((info calc-embedded-info)
|
||||
(extra-line (if (eq calc-language 'big) 1 0))
|
||||
(the-point (point))
|
||||
;; (the-point (point))
|
||||
(empty (= (calc-stack-size) 0))
|
||||
(entry (if empty
|
||||
(list '(var empty var-empty) 1 nil)
|
||||
|
|
@ -1274,6 +1283,7 @@ The command \\[yank] can retrieve it from there."
|
|||
(set-buffer-modified-p (buffer-modified-p)))))
|
||||
|
||||
(defun calc-embedded-modes-change (vars)
|
||||
(defvar the-language) (defvar the-display-just)
|
||||
(if (eq (car vars) 'calc-language) (setq vars '(the-language)))
|
||||
(if (eq (car vars) 'calc-display-just) (setq vars '(the-display-just)))
|
||||
(while (and vars
|
||||
|
|
|
|||
|
|
@ -1398,9 +1398,8 @@ calc-kill calc-kill-region calc-yank))))
|
|||
|
||||
(defun calc-scroll-up (n)
|
||||
(interactive "P")
|
||||
(condition-case nil
|
||||
(scroll-up (or n (/ (window-height) 2)))
|
||||
(error nil))
|
||||
(ignore-errors
|
||||
(scroll-up (or n (/ (window-height) 2))))
|
||||
(if (pos-visible-in-window-p (max 1 (- (point-max) 2)))
|
||||
(if (eq major-mode 'calc-mode)
|
||||
(calc-realign)
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calc-fin.el --- financial functions for Calc
|
||||
;;; calc-fin.el --- financial functions for Calc -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calc-forms.el --- data format conversion functions for Calc
|
||||
;;; calc-forms.el --- data format conversion functions for Calc -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -678,10 +678,11 @@ in the Gregorian calendar."
|
|||
(defvar math-fd-isoweek)
|
||||
(defvar math-fd-isoweekday)
|
||||
|
||||
(defun math-format-date (math-fd-date)
|
||||
(if (eq (car-safe math-fd-date) 'date)
|
||||
(setq math-fd-date (nth 1 math-fd-date)))
|
||||
(let ((entry (list math-fd-date calc-internal-prec calc-date-format)))
|
||||
(defun math-format-date (fd-date)
|
||||
(let* ((math-fd-date (if (eq (car-safe fd-date) 'date)
|
||||
(nth 1 fd-date)
|
||||
fd-date))
|
||||
(entry (list math-fd-date calc-internal-prec calc-date-format)))
|
||||
(or (cdr (assoc entry math-format-date-cache))
|
||||
(let* ((math-fd-dt nil)
|
||||
(math-fd-iso-dt nil)
|
||||
|
|
@ -914,15 +915,16 @@ to Jan 1, 1970 AD.")
|
|||
;; which is called by math-parse-date and math-parse-standard-date.
|
||||
(defvar math-pd-str)
|
||||
|
||||
(defun math-parse-date (math-pd-str)
|
||||
(defun math-parse-date (pd-str)
|
||||
(catch 'syntax
|
||||
(or (math-parse-standard-date math-pd-str t)
|
||||
(math-parse-standard-date math-pd-str nil)
|
||||
(and (string-match "W[0-9][0-9]" math-pd-str)
|
||||
(math-parse-iso-date math-pd-str))
|
||||
(and (string-match "\\`[^-+/0-9a-zA-Z]*\\([-+]?[0-9]+\\.?[0-9]*\\([eE][-+]?[0-9]+\\)?\\)[^-+/0-9a-zA-Z]*\\'" math-pd-str)
|
||||
(list 'date (math-read-number (math-match-substring math-pd-str 1))))
|
||||
(or (math-parse-standard-date pd-str t)
|
||||
(math-parse-standard-date pd-str nil)
|
||||
(and (string-match "W[0-9][0-9]" pd-str)
|
||||
(math-parse-iso-date pd-str))
|
||||
(and (string-match "\\`[^-+/0-9a-zA-Z]*\\([-+]?[0-9]+\\.?[0-9]*\\([eE][-+]?[0-9]+\\)?\\)[^-+/0-9a-zA-Z]*\\'" pd-str)
|
||||
(list 'date (math-read-number (math-match-substring pd-str 1))))
|
||||
(let ((case-fold-search t)
|
||||
(math-pd-str pd-str)
|
||||
(year nil) (month nil) (day nil) (weekday nil)
|
||||
(hour nil) (minute nil) (second nil) (bc-flag nil)
|
||||
(a nil) (b nil) (c nil) (bigyear nil) temp)
|
||||
|
|
@ -1128,8 +1130,9 @@ to Jan 1, 1970 AD.")
|
|||
(substring math-pd-str (match-end 0))))
|
||||
n))))
|
||||
|
||||
(defun math-parse-standard-date (math-pd-str with-time)
|
||||
(let ((case-fold-search t)
|
||||
(defun math-parse-standard-date (pd-str with-time)
|
||||
(let ((math-pd-str pd-str)
|
||||
(case-fold-search t)
|
||||
(okay t) num
|
||||
(fmt calc-date-format) this next (gnext nil)
|
||||
(isoyear nil) (isoweek nil) (isoweekday nil)
|
||||
|
|
@ -1306,9 +1309,10 @@ to Jan 1, 1970 AD.")
|
|||
(setq day (math-add day (1- yearday))))
|
||||
day))))))
|
||||
|
||||
(defun math-parse-iso-date (math-pd-str)
|
||||
"Parse MATH-PD-STR as an ISO week date, or return nil."
|
||||
(let ((case-fold-search t)
|
||||
(defun math-parse-iso-date (pd-str)
|
||||
"Parse PD-STR as an ISO week date, or return nil."
|
||||
(let ((math-pd-str pd-str)
|
||||
(case-fold-search t)
|
||||
(isoyear nil) (isoweek nil) (isoweekday nil)
|
||||
(hour nil) (minute nil) (second nil))
|
||||
;; Extract the time, if any.
|
||||
|
|
@ -1613,7 +1617,7 @@ and ends on the first Sunday of November at 2 a.m."
|
|||
(math-std-daylight-savings-old date dt zone bump)
|
||||
(math-std-daylight-savings-new date dt zone bump)))
|
||||
|
||||
(defun math-std-daylight-savings-new (date dt zone bump)
|
||||
(defun math-std-daylight-savings-new (date dt _zone bump)
|
||||
"Standard North American daylight saving algorithm as of 2007.
|
||||
This implements the rules for the U.S. and Canada.
|
||||
Daylight saving begins on the second Sunday of March at 2 a.m.,
|
||||
|
|
@ -1634,7 +1638,7 @@ and ends on the first Sunday of November at 2 a.m."
|
|||
(t 0))))
|
||||
(t 0)))
|
||||
|
||||
(defun math-std-daylight-savings-old (date dt zone bump)
|
||||
(defun math-std-daylight-savings-old (date dt _zone bump)
|
||||
"Standard North American daylight saving algorithm before 2007.
|
||||
This implements the rules for the U.S. and Canada.
|
||||
Daylight saving begins on the first Sunday of April at 2 a.m.,
|
||||
|
|
@ -1657,7 +1661,7 @@ and ends on the last Sunday of October at 2 a.m."
|
|||
|
||||
;;; Compute the day (1-31) of the WDAY (0-6) on or preceding the given
|
||||
;;; day of the given month.
|
||||
(defun math-prev-weekday-in-month (date dt day wday)
|
||||
(defun math-prev-weekday-in-month (date dt day _wday)
|
||||
(or day (setq day (nth 2 dt)))
|
||||
(if (> day (math-days-in-month (car dt) (nth 1 dt)))
|
||||
(setq day (math-days-in-month (car dt) (nth 1 dt))))
|
||||
|
|
@ -2036,18 +2040,18 @@ and ends on the last Sunday of October at 2 a.m."
|
|||
nil)))
|
||||
(or done (setq math-holidays-cache-tag t))))))
|
||||
|
||||
(defun math-setup-year-holidays (math-sh-year)
|
||||
(let ((exprs (nth 2 math-holidays-cache)))
|
||||
(while exprs
|
||||
(defun math-setup-year-holidays (sh-year)
|
||||
(let ((math-sh-year sh-year))
|
||||
(dolist (expr (nth 2 math-holidays-cache))
|
||||
(defvar var-y) (defvar var-m)
|
||||
(let* ((var-y math-sh-year)
|
||||
(var-m nil)
|
||||
(expr (math-evaluate-expr (car exprs))))
|
||||
(expr (math-evaluate-expr expr)))
|
||||
(if (math-expr-contains expr '(var m var-m))
|
||||
(let ((var-m 0))
|
||||
(while (<= (setq var-m (1+ var-m)) 12)
|
||||
(math-setup-add-holidays (math-evaluate-expr expr))))
|
||||
(math-setup-add-holidays expr)))
|
||||
(setq exprs (cdr exprs)))))
|
||||
(math-setup-add-holidays expr))))))
|
||||
|
||||
(defun math-setup-add-holidays (days) ; uses "math-sh-year"
|
||||
(cond ((eq (car-safe days) 'vec)
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calc-frac.el --- fraction functions for Calc
|
||||
;;; calc-frac.el --- fraction functions for Calc -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calc-funcs.el --- well-known functions for Calc
|
||||
;;; calc-funcs.el --- well-known functions for Calc -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calc-graph.el --- graph output functions for Calc
|
||||
;;; calc-graph.el --- graph output functions for Calc -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -216,7 +216,7 @@
|
|||
(or (and (Math-num-integerp pstyle) (math-trunc pstyle))
|
||||
(if (eq (car-safe (calc-var-value (nth 2 ydata))) 'vec)
|
||||
0 -1))
|
||||
(math-contains-sdev-p (eval (nth 2 ydata))))))
|
||||
(math-contains-sdev-p (eval (nth 2 ydata) t)))))
|
||||
|
||||
(defun calc-graph-lookup (thing)
|
||||
(if (and (eq (car-safe thing) 'var)
|
||||
|
|
@ -319,7 +319,6 @@
|
|||
(calc-slow-wrapper
|
||||
(let ((calcbuf (current-buffer))
|
||||
(tempbuf (get-buffer-create "*Gnuplot Temp-2*"))
|
||||
(tempbuftop 1)
|
||||
(tempoutfile nil)
|
||||
(calc-graph-curve-num 0)
|
||||
(calc-graph-refine (and flag (> (prefix-numeric-value flag) 0)))
|
||||
|
|
@ -403,7 +402,7 @@
|
|||
(and (equal output "tty") (setq tty-output t)))
|
||||
(setq tempoutfile (calc-temp-file-name -1)
|
||||
output tempoutfile))
|
||||
(setq output (eval output)))
|
||||
(setq output (eval output t)))
|
||||
(or (equal device calc-graph-last-device)
|
||||
(progn
|
||||
(setq calc-graph-last-device device)
|
||||
|
|
@ -480,9 +479,11 @@
|
|||
(calc-graph-xp calc-graph-xvalue)
|
||||
(calc-graph-yp calc-graph-yvalue)
|
||||
(calc-graph-zp nil)
|
||||
(calc-graph-xlow nil) (calc-graph-xhigh nil) (y3low nil) (y3high nil)
|
||||
(calc-graph-xlow nil) (calc-graph-xhigh nil)
|
||||
;; (y3low nil) (y3high nil)
|
||||
calc-graph-xvec calc-graph-xval calc-graph-xstep var-DUMMY
|
||||
y3val calc-graph-y3step var-DUMMY2 (calc-graph-zval nil)
|
||||
;; y3val
|
||||
calc-graph-y3step var-DUMMY2 (calc-graph-zval nil)
|
||||
calc-graph-yvec calc-graph-yval calc-graph-ycache calc-graph-ycacheptr calc-graph-yvector
|
||||
calc-graph-numsteps calc-graph-numsteps3
|
||||
(calc-graph-keep-file (and (not calc-graph-is-splot) (file-exists-p filename)))
|
||||
|
|
@ -562,7 +563,7 @@
|
|||
calc-gnuplot-print-output)))
|
||||
(if (symbolp command)
|
||||
(funcall command output)
|
||||
(eval command))))))))))
|
||||
(eval command t))))))))))
|
||||
|
||||
(defun calc-graph-compute-2d ()
|
||||
(if (setq calc-graph-yvec (eq (car-safe calc-graph-yvalue) 'vec))
|
||||
|
|
@ -905,16 +906,15 @@
|
|||
(while calc-graph-file-cache
|
||||
(and (car calc-graph-file-cache)
|
||||
(file-exists-p (car (car calc-graph-file-cache)))
|
||||
(condition-case err
|
||||
(delete-file (car (car calc-graph-file-cache)))
|
||||
(error nil)))
|
||||
(ignore-errors
|
||||
(delete-file (car (car calc-graph-file-cache)))))
|
||||
(setq calc-graph-file-cache (cdr calc-graph-file-cache))))
|
||||
|
||||
(defun calc-graph-kill-hook ()
|
||||
(calc-graph-delete-temps))
|
||||
|
||||
(defun calc-graph-show-tty (output)
|
||||
"Default calc-gnuplot-plot-command for \"tty\" output mode.
|
||||
"Default `calc-gnuplot-plot-command' for \"tty\" output mode.
|
||||
This is useful for tek40xx and other graphics-terminal types."
|
||||
(call-process shell-file-name nil calc-gnuplot-buffer nil
|
||||
shell-command-switch
|
||||
|
|
@ -923,7 +923,7 @@ This is useful for tek40xx and other graphics-terminal types."
|
|||
(defvar calc-dumb-map nil
|
||||
"The keymap for the \"dumb\" terminal plot.")
|
||||
|
||||
(defun calc-graph-show-dumb (&optional output)
|
||||
(defun calc-graph-show-dumb (&optional _output)
|
||||
"Default calc-gnuplot-plot-command for Pinard's \"dumb\" terminal type.
|
||||
This \"dumb\" driver will be present in Gnuplot 3.0."
|
||||
(interactive)
|
||||
|
|
@ -1116,14 +1116,14 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
|
|||
(delete-region start end)
|
||||
(goto-char start)
|
||||
(setq errform
|
||||
(condition-case nil
|
||||
(math-contains-sdev-p
|
||||
(eval (intern
|
||||
(concat "var-"
|
||||
(save-excursion
|
||||
(re-search-backward ":\\(.*\\)}")
|
||||
(match-string 1))))))
|
||||
(error nil)))
|
||||
(ignore-errors
|
||||
(math-contains-sdev-p
|
||||
(symbol-value
|
||||
(intern
|
||||
(concat "var-"
|
||||
(save-excursion
|
||||
(re-search-backward ":\\(.*\\)}")
|
||||
(match-string 1))))))))
|
||||
(if yerr
|
||||
(insert " with yerrorbars")
|
||||
(insert " with "
|
||||
|
|
@ -1165,7 +1165,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
|
|||
(or (calc-graph-find-plot nil nil)
|
||||
(error "No data points have been set!"))
|
||||
(let ((base (point))
|
||||
start
|
||||
;; start
|
||||
end)
|
||||
(re-search-forward "[,\n]\\|[ \t]+with")
|
||||
(setq end (match-beginning 0))
|
||||
|
|
@ -1462,7 +1462,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
|
|||
(match-beginning 1)
|
||||
(match-end 1))))
|
||||
(setq calc-gnuplot-version 1))))
|
||||
(condition-case err
|
||||
(condition-case nil
|
||||
(let ((args (append (and calc-gnuplot-display
|
||||
(not (equal calc-gnuplot-display
|
||||
(getenv "DISPLAY")))
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calc-help.el --- help display functions for Calc,
|
||||
;;; calc-help.el --- help display functions for Calc -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -33,8 +33,8 @@
|
|||
(declare-function Info-last "info" ())
|
||||
|
||||
|
||||
(defun calc-help-prefix (arg)
|
||||
"This key is the prefix for Calc help functions. See calc-help-for-help."
|
||||
(defun calc-help-prefix (&optional _arg)
|
||||
"This key is the prefix for Calc help functions. See `calc-help-for-help'."
|
||||
(interactive "P")
|
||||
(or calc-dispatch-help (sit-for echo-keystrokes))
|
||||
(let ((key (calc-read-key-sequence
|
||||
|
|
@ -79,7 +79,7 @@ C-w Describe how there is no warranty for Calc."
|
|||
(message "Calc Help options: Help, Info, ... press SPC, DEL to scroll, C-g to cancel")
|
||||
(memq (setq key (read-event))
|
||||
'(? ?\C-h ?\C-? ?\C-v ?\M-v)))
|
||||
(condition-case err
|
||||
(condition-case nil
|
||||
(if (memq key '(? ?\C-v))
|
||||
(scroll-up)
|
||||
(scroll-down))
|
||||
|
|
@ -302,21 +302,19 @@ C-w Describe how there is no warranty for Calc."
|
|||
(let ((entrylist '())
|
||||
entry)
|
||||
(require 'info nil t)
|
||||
(while indices
|
||||
(condition-case nil
|
||||
(with-temp-buffer
|
||||
(Info-mode)
|
||||
(Info-goto-node (concat "(Calc)" (car indices) " Index"))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "\n\\* \\(.*\\): " nil t)
|
||||
(setq entry (match-string 1))
|
||||
(if (and (not (string-match "<[1-9]+>" entry))
|
||||
(not (string-match "(.*)" entry))
|
||||
(not (string= entry "Menu")))
|
||||
(unless (assoc entry entrylist)
|
||||
(setq entrylist (cons entry entrylist))))))
|
||||
(error nil))
|
||||
(setq indices (cdr indices)))
|
||||
(dolist (indice indices)
|
||||
(ignore-errors
|
||||
(with-temp-buffer
|
||||
(Info-mode)
|
||||
(Info-goto-node (concat "(Calc)" indice " Index"))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "\n\\* \\(.*\\): " nil t)
|
||||
(setq entry (match-string 1))
|
||||
(if (and (not (string-match "<[1-9]+>" entry))
|
||||
(not (string-match "(.*)" entry))
|
||||
(not (string= entry "Menu")))
|
||||
(unless (assoc entry entrylist)
|
||||
(setq entrylist (cons entry entrylist))))))))
|
||||
entrylist))
|
||||
|
||||
(defun calc-describe-function (&optional func)
|
||||
|
|
@ -409,9 +407,7 @@ C-w Describe how there is no warranty for Calc."
|
|||
(substitute-command-keys x)))))
|
||||
(nreverse (cdr (reverse (cdr (calc-help))))))
|
||||
(mapc (function (lambda (prefix)
|
||||
(let ((msgs (condition-case err
|
||||
(funcall prefix)
|
||||
(error nil))))
|
||||
(let ((msgs (ignore-errors (funcall prefix))))
|
||||
(if (car msgs)
|
||||
(princ
|
||||
(if (eq (nth 2 msgs) ?v)
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calc-incom.el --- complex data type input functions for Calc
|
||||
;;; calc-incom.el --- complex data type input functions for Calc -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calc-keypd.el --- mouse-capable keypad input for Calc
|
||||
;;; calc-keypd.el --- mouse-capable keypad input for Calc -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -35,17 +35,17 @@
|
|||
(defvar calc-keypad-prev-input nil)
|
||||
(defvar calc-keypad-said-hello nil)
|
||||
|
||||
;;; |----+----+----+----+----+----|
|
||||
;;; | ENTER |+/- |EEX |UNDO| <- |
|
||||
;;; |-----+---+-+--+--+-+---++----|
|
||||
;;; | INV | 7 | 8 | 9 | / |
|
||||
;;; |-----+-----+-----+-----+-----|
|
||||
;;; | HYP | 4 | 5 | 6 | * |
|
||||
;;; |-----+-----+-----+-----+-----|
|
||||
;;; |EXEC | 1 | 2 | 3 | - |
|
||||
;;; |-----+-----+-----+-----+-----|
|
||||
;;; | OFF | 0 | . | PI | + |
|
||||
;;; |-----+-----+-----+-----+-----|
|
||||
;; |----+----+----+----+----+----|
|
||||
;; | ENTER |+/- |EEX |UNDO| <- |
|
||||
;; |-----+---+-+--+--+-+---++----|
|
||||
;; | INV | 7 | 8 | 9 | / |
|
||||
;; |-----+-----+-----+-----+-----|
|
||||
;; | HYP | 4 | 5 | 6 | * |
|
||||
;; |-----+-----+-----+-----+-----|
|
||||
;; |EXEC | 1 | 2 | 3 | - |
|
||||
;; |-----+-----+-----+-----+-----|
|
||||
;; | OFF | 0 | . | PI | + |
|
||||
;; |-----+-----+-----+-----+-----|
|
||||
(defvar calc-keypad-layout
|
||||
'( ( ( "ENTER" calc-enter calc-roll-down calc-roll-up calc-over )
|
||||
( "ENTER" calc-enter calc-roll-down calc-roll-up calc-over )
|
||||
|
|
@ -83,12 +83,12 @@
|
|||
calc-keypad-modes-menu
|
||||
calc-keypad-user-menu ) )
|
||||
|
||||
;;; |----+----+----+----+----+----|
|
||||
;;; |FLR |CEIL|RND |TRNC|CLN2|FLT |
|
||||
;;; |----+----+----+----+----+----|
|
||||
;;; | LN |EXP | |ABS |IDIV|MOD |
|
||||
;;; |----+----+----+----+----+----|
|
||||
;;; |SIN |COS |TAN |SQRT|y^x |1/x |
|
||||
;; |----+----+----+----+----+----|
|
||||
;; |FLR |CEIL|RND |TRNC|CLN2|FLT |
|
||||
;; |----+----+----+----+----+----|
|
||||
;; | LN |EXP | |ABS |IDIV|MOD |
|
||||
;; |----+----+----+----+----+----|
|
||||
;; |SIN |COS |TAN |SQRT|y^x |1/x |
|
||||
|
||||
(defvar calc-keypad-math-menu
|
||||
'( ( ( "FLR" calc-floor )
|
||||
|
|
@ -110,12 +110,12 @@
|
|||
( "y^x" calc-power )
|
||||
( "1/x" calc-inv ) ) ))
|
||||
|
||||
;;; |----+----+----+----+----+----|
|
||||
;;; |IGAM|BETA|IBET|ERF |BESJ|BESY|
|
||||
;;; |----+----+----+----+----+----|
|
||||
;;; |IMAG|CONJ| RE |ATN2|RAND|RAGN|
|
||||
;;; |----+----+----+----+----+----|
|
||||
;;; |GCD |FACT|DFCT|BNOM|PERM|NXTP|
|
||||
;; |----+----+----+----+----+----|
|
||||
;; |IGAM|BETA|IBET|ERF |BESJ|BESY|
|
||||
;; |----+----+----+----+----+----|
|
||||
;; |IMAG|CONJ| RE |ATN2|RAND|RAGN|
|
||||
;; |----+----+----+----+----+----|
|
||||
;; |GCD |FACT|DFCT|BNOM|PERM|NXTP|
|
||||
|
||||
(defvar calc-keypad-funcs-menu
|
||||
'( ( ( "IGAM" calc-inc-gamma )
|
||||
|
|
@ -137,12 +137,12 @@
|
|||
( "PERM" calc-perm )
|
||||
( "NXTP" calc-next-prime calc-prev-prime ) ) ))
|
||||
|
||||
;;; |----+----+----+----+----+----|
|
||||
;;; |AND | OR |XOR |NOT |LSH |RSH |
|
||||
;;; |----+----+----+----+----+----|
|
||||
;;; |DEC |HEX |OCT |BIN |WSIZ|ARSH|
|
||||
;;; |----+----+----+----+----+----|
|
||||
;;; | A | B | C | D | E | F |
|
||||
;; |----+----+----+----+----+----|
|
||||
;; |AND | OR |XOR |NOT |LSH |RSH |
|
||||
;; |----+----+----+----+----+----|
|
||||
;; |DEC |HEX |OCT |BIN |WSIZ|ARSH|
|
||||
;; |----+----+----+----+----+----|
|
||||
;; | A | B | C | D | E | F |
|
||||
|
||||
(defvar calc-keypad-binary-menu
|
||||
'( ( ( "AND" calc-and calc-diff )
|
||||
|
|
@ -164,12 +164,12 @@
|
|||
( "E" ("E") )
|
||||
( "F" ("F") ) ) ))
|
||||
|
||||
;;; |----+----+----+----+----+----|
|
||||
;;; |SUM |PROD|MAX |MAP*|MAP^|MAP$|
|
||||
;;; |----+----+----+----+----+----|
|
||||
;;; |INV |DET |TRN |IDNT|CRSS|"x" |
|
||||
;;; |----+----+----+----+----+----|
|
||||
;;; |PACK|UNPK|INDX|BLD |LEN |... |
|
||||
;; |----+----+----+----+----+----|
|
||||
;; |SUM |PROD|MAX |MAP*|MAP^|MAP$|
|
||||
;; |----+----+----+----+----+----|
|
||||
;; |INV |DET |TRN |IDNT|CRSS|"x" |
|
||||
;; |----+----+----+----+----+----|
|
||||
;; |PACK|UNPK|INDX|BLD |LEN |... |
|
||||
|
||||
(defvar calc-keypad-vector-menu
|
||||
'( ( ( "SUM" calc-vector-sum calc-vector-alt-sum calc-vector-mean )
|
||||
|
|
@ -196,12 +196,12 @@
|
|||
( "LEN" calc-vlength )
|
||||
( "..." calc-full-vectors ) ) ))
|
||||
|
||||
;;; |----+----+----+----+----+----|
|
||||
;;; |FLT |FIX |SCI |ENG |GRP | |
|
||||
;;; |----+----+----+----+----+----|
|
||||
;;; |RAD |DEG |FRAC|POLR|SYMB|PREC|
|
||||
;;; |----+----+----+----+----+----|
|
||||
;;; |SWAP|RLL3|RLL4|OVER|STO |RCL |
|
||||
;; |----+----+----+----+----+----|
|
||||
;; |FLT |FIX |SCI |ENG |GRP | |
|
||||
;; |----+----+----+----+----+----|
|
||||
;; |RAD |DEG |FRAC|POLR|SYMB|PREC|
|
||||
;; |----+----+----+----+----+----|
|
||||
;; |SWAP|RLL3|RLL4|OVER|STO |RCL |
|
||||
|
||||
(defvar calc-keypad-modes-menu
|
||||
'( ( ( "FLT" calc-normal-notation
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calc-lang.el --- calc language functions
|
||||
;;; calc-lang.el --- calc language functions -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -45,6 +45,8 @@
|
|||
(defvar math-comp-comma)
|
||||
(defvar math-comp-vector-prec)
|
||||
|
||||
(defvar math-exp-str) ;; Dyn scoped
|
||||
|
||||
;;; Alternate entry/display languages.
|
||||
|
||||
(defun calc-set-language (lang &optional option no-refresh)
|
||||
|
|
@ -144,7 +146,7 @@
|
|||
( y1 . (math-C-parse-bess))
|
||||
( tgamma . calcFunc-gamma )))
|
||||
|
||||
(defun math-C-parse-bess (f val)
|
||||
(defun math-C-parse-bess (_f val)
|
||||
"Parse C's j0, j1, y0, y1 functions."
|
||||
(let ((args (math-read-expr-list)))
|
||||
(math-read-token)
|
||||
|
|
@ -155,7 +157,7 @@
|
|||
((eq val 'y1) '(calcFunc-besY 1)))
|
||||
args)))
|
||||
|
||||
(defun math-C-parse-fma (f val)
|
||||
(defun math-C-parse-fma (_f _val)
|
||||
"Parse C's fma function fma(x,y,z) => (x * y + z)."
|
||||
(let ((args (math-read-expr-list)))
|
||||
(math-read-token)
|
||||
|
|
@ -372,14 +374,14 @@
|
|||
(defvar math-exp-old-pos)
|
||||
|
||||
(defvar math-parsing-fortran-vector nil)
|
||||
(defun math-parse-fortran-vector (op)
|
||||
(defun math-parse-fortran-vector (_op)
|
||||
(let ((math-parsing-fortran-vector '(end . "\000")))
|
||||
(prog1
|
||||
(math-read-brackets t "]")
|
||||
(setq math-exp-token (car math-parsing-fortran-vector)
|
||||
math-expr-data (cdr math-parsing-fortran-vector)))))
|
||||
|
||||
(defun math-parse-fortran-vector-end (x op)
|
||||
(defun math-parse-fortran-vector-end (x _op)
|
||||
(if math-parsing-fortran-vector
|
||||
(progn
|
||||
(setq math-parsing-fortran-vector (cons math-exp-token math-expr-data)
|
||||
|
|
@ -692,7 +694,7 @@
|
|||
"_{" (math-compose-expr (nth 2 a) 0)
|
||||
"}{" (math-compose-expr (nth 1 a) 0) "}"))))
|
||||
|
||||
(defun math-parse-tex-sum (f val)
|
||||
(defun math-parse-tex-sum (f _val)
|
||||
(let (low high save)
|
||||
(or (equal math-expr-data "_") (throw 'syntax "Expected `_'"))
|
||||
(math-read-token)
|
||||
|
|
@ -727,14 +729,15 @@
|
|||
(math-compose-expr (nth 3 a) 0)
|
||||
(if (memq (nth 1 a) '(0 2)) ")" "]")))
|
||||
|
||||
(defun math-compose-tex-var (a prec)
|
||||
(defun math-compose-tex-var (a _prec)
|
||||
(if (and calc-language-option
|
||||
(not (= calc-language-option 0))
|
||||
(string-match "\\`[a-zA-Zα-ωΑ-Ω][a-zA-Zα-ωΑ-Ω0-9]+\\'"
|
||||
(symbol-name (nth 1 a))))
|
||||
(if (eq calc-language 'latex)
|
||||
(format "\\text{%s}" (symbol-name (nth 1 a)))
|
||||
(format "\\hbox{%s}" (symbol-name (nth 1 a))))
|
||||
(format (if (eq calc-language 'latex)
|
||||
"\\text{%s}"
|
||||
"\\hbox{%s}")
|
||||
(symbol-name (nth 1 a)))
|
||||
(math-compose-var a)))
|
||||
|
||||
(defun math-compose-tex-func (func a)
|
||||
|
|
@ -906,7 +909,7 @@
|
|||
(setq math-exp-str (copy-sequence math-exp-str))
|
||||
(aset math-exp-str right ?\]))))))))))
|
||||
|
||||
(defun math-latex-parse-frac (f val)
|
||||
(defun math-latex-parse-frac (_f _val)
|
||||
(let (numer denom)
|
||||
(setq numer (car (math-read-expr-list)))
|
||||
(math-read-token)
|
||||
|
|
@ -916,7 +919,7 @@
|
|||
(list 'frac numer denom)
|
||||
(list '/ numer denom))))
|
||||
|
||||
(defun math-latex-parse-two-args (f val)
|
||||
(defun math-latex-parse-two-args (f _val)
|
||||
(let (first second)
|
||||
(setq first (car (math-read-expr-list)))
|
||||
(math-read-token)
|
||||
|
|
@ -931,7 +934,7 @@
|
|||
|
||||
(put 'latex 'math-input-filter 'math-tex-input-filter)
|
||||
|
||||
(defun calc-eqn-language (n)
|
||||
(defun calc-eqn-language (_n)
|
||||
(interactive "P")
|
||||
(calc-wrapper
|
||||
(calc-set-language 'eqn)
|
||||
|
|
@ -1159,7 +1162,7 @@
|
|||
(math-compose-eqn-matrix (cdr a)))))))
|
||||
nil))
|
||||
|
||||
(defun math-parse-eqn-matrix (f sym)
|
||||
(defun math-parse-eqn-matrix (_f _sym)
|
||||
(let ((vec nil))
|
||||
(while (assoc math-expr-data '(("ccol") ("lcol") ("rcol")))
|
||||
(math-read-token)
|
||||
|
|
@ -1175,7 +1178,7 @@
|
|||
(math-read-token)
|
||||
(math-transpose (cons 'vec (nreverse vec)))))
|
||||
|
||||
(defun math-parse-eqn-prime (x sym)
|
||||
(defun math-parse-eqn-prime (x _sym)
|
||||
(if (eq (car-safe x) 'var)
|
||||
(if (equal math-expr-data calc-function-open)
|
||||
(progn
|
||||
|
|
@ -1363,7 +1366,7 @@
|
|||
(math-compose-vector args ", " 0)
|
||||
"]")))))
|
||||
|
||||
(defun math-yacas-parse-Sum (f val)
|
||||
(defun math-yacas-parse-Sum (f _val)
|
||||
"Read in the arguments to \"Sum\" in Calc's Yacas mode."
|
||||
(let ((args (math-read-expr-list)))
|
||||
(math-read-token)
|
||||
|
|
@ -1512,7 +1515,7 @@
|
|||
( substitute . (math-maxima-parse-subst))
|
||||
( taylor . (math-maxima-parse-taylor))))
|
||||
|
||||
(defun math-maxima-parse-subst (f val)
|
||||
(defun math-maxima-parse-subst (_f _val)
|
||||
"Read in the arguments to \"subst\" in Calc's Maxima mode."
|
||||
(let ((args (math-read-expr-list)))
|
||||
(math-read-token)
|
||||
|
|
@ -1521,7 +1524,7 @@
|
|||
(nth 2 args)
|
||||
(nth 0 args))))
|
||||
|
||||
(defun math-maxima-parse-taylor (f val)
|
||||
(defun math-maxima-parse-taylor (_f _val)
|
||||
"Read in the arguments to \"taylor\" in Calc's Maxima mode."
|
||||
(let ((args (math-read-expr-list)))
|
||||
(math-read-token)
|
||||
|
|
@ -1762,7 +1765,7 @@
|
|||
( contains . (math-lang-switch-args calcFunc-in))
|
||||
( has . (math-lang-switch-args calcFunc-refers))))
|
||||
|
||||
(defun math-lang-switch-args (f val)
|
||||
(defun math-lang-switch-args (f _val)
|
||||
"Read the arguments to a Calc function in reverse order.
|
||||
This is used for various language modes which have functions in reverse
|
||||
order to Calc's."
|
||||
|
|
@ -1805,15 +1808,15 @@ order to Calc's."
|
|||
(put 'giac 'math-compose-subscr
|
||||
(function
|
||||
(lambda (a)
|
||||
(let ((args (cdr (cdr a))))
|
||||
;; (let ((args (cdr (cdr a))))
|
||||
(list 'horiz
|
||||
(math-compose-expr (nth 1 a) 1000)
|
||||
"["
|
||||
(math-compose-expr
|
||||
(calc-normalize (list '- (nth 2 a) 1)) 0)
|
||||
"]")))))
|
||||
"]")))) ;;)
|
||||
|
||||
(defun math-read-giac-subscr (x op)
|
||||
(defun math-read-giac-subscr (x _op)
|
||||
(let ((idx (math-read-expr-level 0)))
|
||||
(or (equal math-expr-data "]")
|
||||
(throw 'syntax "Expected `]'"))
|
||||
|
|
@ -1947,7 +1950,7 @@ order to Calc's."
|
|||
(math-compose-expr (nth 2 a) 0)
|
||||
"]]"))))
|
||||
|
||||
(defun math-read-math-subscr (x op)
|
||||
(defun math-read-math-subscr (x _op)
|
||||
(let ((idx (math-read-expr-level 0)))
|
||||
(or (and (equal math-expr-data "]")
|
||||
(progn
|
||||
|
|
@ -2094,10 +2097,13 @@ order to Calc's."
|
|||
(defvar math-rb-v1)
|
||||
(defvar math-rb-v2)
|
||||
|
||||
(defun math-read-big-rec (math-rb-h1 math-rb-v1 math-rb-h2 math-rb-v2
|
||||
(defun math-read-big-rec (rb-h1 rb-v1 rb-h2 rb-v2
|
||||
&optional baseline prec short)
|
||||
(or prec (setq prec 0))
|
||||
|
||||
(let ((math-rb-h1 rb-h1)
|
||||
(math-rb-v1 rb-v1)
|
||||
(math-rb-h2 rb-h2)
|
||||
(math-rb-v2 rb-v2))
|
||||
;; Clip whitespace above or below.
|
||||
(while (and (< math-rb-v1 math-rb-v2)
|
||||
(math-read-big-emptyp math-rb-h1 math-rb-v1 math-rb-h2 (1+ math-rb-v1)))
|
||||
|
|
@ -2449,7 +2455,7 @@ order to Calc's."
|
|||
math-read-big-h2 h)
|
||||
(or short (= math-read-big-h2 math-rb-h2)
|
||||
(math-read-big-error h baseline))
|
||||
p)))
|
||||
p))))
|
||||
|
||||
(defun math-read-big-char (h v)
|
||||
(or (and (>= h math-rb-h1)
|
||||
|
|
|
|||
|
|
@ -61,6 +61,7 @@
|
|||
(defmacro calc-with-trail-buffer (&rest body)
|
||||
`(let ((save-buf (current-buffer))
|
||||
(calc-command-flags nil))
|
||||
(ignore save-buf) ;FIXME: Use a name less conflict-prone!
|
||||
(with-current-buffer (calc-trail-display t)
|
||||
(progn
|
||||
(goto-char calc-trail-pointer)
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calc-map.el --- higher-order functions for Calc
|
||||
;;; calc-map.el --- higher-order functions for Calc -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -48,6 +48,8 @@
|
|||
(math-calcFunc-to-var (nth 1 oper))
|
||||
expr)))))
|
||||
|
||||
(defvar calc-mapping-dir nil)
|
||||
|
||||
(defun calc-reduce (&optional oper accum)
|
||||
(interactive)
|
||||
(calc-wrapper
|
||||
|
|
@ -136,7 +138,6 @@
|
|||
(1+ calc-dollar-used))))))))
|
||||
|
||||
(defvar calc-verify-arglist t)
|
||||
(defvar calc-mapping-dir nil)
|
||||
(defun calc-map-stack ()
|
||||
"This is meant to be called by calc-keypad mode."
|
||||
(interactive)
|
||||
|
|
@ -853,7 +854,7 @@
|
|||
(i -1)
|
||||
(math-working-step 0)
|
||||
(math-working-step-2 nil)
|
||||
len cols obj expr)
|
||||
len obj expr) ;; cols
|
||||
(if (eq mode 'eqn)
|
||||
(setq mode 'elems
|
||||
heads '(calcFunc-eq calcFunc-neq calcFunc-lt calcFunc-gt
|
||||
|
|
@ -1023,22 +1024,21 @@
|
|||
(let ((expr (car (setq vec (cdr vec)))))
|
||||
(if expr
|
||||
(progn
|
||||
(condition-case err
|
||||
(and (symbolp func)
|
||||
(let ((lfunc (or (cdr (assq func
|
||||
'( (calcFunc-add . math-add)
|
||||
(calcFunc-sub . math-sub)
|
||||
(calcFunc-mul . math-mul)
|
||||
(calcFunc-div . math-div)
|
||||
(calcFunc-pow . math-pow)
|
||||
(calcFunc-mod . math-mod)
|
||||
(calcFunc-vconcat .
|
||||
math-concat) )))
|
||||
func)))
|
||||
(while (cdr vec)
|
||||
(setq expr (funcall lfunc expr (nth 1 vec))
|
||||
vec (cdr vec)))))
|
||||
(error nil))
|
||||
(ignore-errors
|
||||
(and (symbolp func)
|
||||
(let ((lfunc (or (cdr (assq func
|
||||
'( (calcFunc-add . math-add)
|
||||
(calcFunc-sub . math-sub)
|
||||
(calcFunc-mul . math-mul)
|
||||
(calcFunc-div . math-div)
|
||||
(calcFunc-pow . math-pow)
|
||||
(calcFunc-mod . math-mod)
|
||||
(calcFunc-vconcat
|
||||
. math-concat) )))
|
||||
func)))
|
||||
(while (cdr vec)
|
||||
(setq expr (funcall lfunc expr (nth 1 vec))
|
||||
vec (cdr vec))))))
|
||||
(while (setq vec (cdr vec))
|
||||
(setq expr (math-build-call func (list expr (car vec)))))
|
||||
(math-normalize expr))
|
||||
|
|
@ -1229,9 +1229,11 @@
|
|||
(defvar math-inner-mul-func)
|
||||
(defvar math-inner-add-func)
|
||||
|
||||
(defun calcFunc-inner (math-inner-mul-func math-inner-add-func a b)
|
||||
(defun calcFunc-inner (inner-mul-func inner-add-func a b)
|
||||
(or (math-vectorp a) (math-reject-arg a 'vectorp))
|
||||
(or (math-vectorp b) (math-reject-arg b 'vectorp))
|
||||
(let ((math-inner-mul-func inner-mul-func)
|
||||
(math-inner-add-func inner-add-func))
|
||||
(if (math-matrixp a)
|
||||
(if (math-matrixp b)
|
||||
(if (= (length (nth 1 a)) (length b))
|
||||
|
|
@ -1247,12 +1249,12 @@
|
|||
(math-dimension-error))))
|
||||
(if (math-matrixp b)
|
||||
(nth 1 (math-inner-mats (list 'vec a) b))
|
||||
(calcFunc-reduce math-inner-add-func (calcFunc-map math-inner-mul-func a b)))))
|
||||
(calcFunc-reduce math-inner-add-func (calcFunc-map math-inner-mul-func a b))))))
|
||||
|
||||
(defun math-inner-mats (a b)
|
||||
(let ((mat nil)
|
||||
(cols (length (nth 1 b)))
|
||||
row col ap bp accum)
|
||||
row col) ;; ap bp accum
|
||||
(while (setq a (cdr a))
|
||||
(setq col cols
|
||||
row nil)
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calc-math.el --- mathematical functions for Calc
|
||||
;;; calc-math.el --- mathematical functions for Calc -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -60,33 +60,23 @@
|
|||
pow
|
||||
(< pow 1.0e+INF))
|
||||
(setq x (* 2 x))
|
||||
(setq pow (condition-case nil
|
||||
(expt 10.0 (* 2 x))
|
||||
(error nil))))
|
||||
(setq pow (ignore-errors (expt 10.0 (* 2 x)))))
|
||||
;; The following loop should stop when 10^(x+1) is too large.
|
||||
(setq pow (condition-case nil
|
||||
(expt 10.0 (1+ x))
|
||||
(error nil)))
|
||||
(setq pow (ignore-errors (expt 10.0 (1+ x))))
|
||||
(while (and
|
||||
pow
|
||||
(< pow 1.0e+INF))
|
||||
(setq x (1+ x))
|
||||
(setq pow (condition-case nil
|
||||
(expt 10.0 (1+ x))
|
||||
(error nil))))
|
||||
(setq pow (ignore-errors (expt 10.0 (1+ x)))))
|
||||
(1- x))
|
||||
"The largest exponent which Calc will convert to an Emacs float.")
|
||||
|
||||
(defvar math-smallest-emacs-expt
|
||||
(let ((x -1))
|
||||
(while (condition-case nil
|
||||
(> (expt 10.0 x) 0.0)
|
||||
(error nil))
|
||||
(while (ignore-errors (> (expt 10.0 x) 0.0))
|
||||
(setq x (* 2 x)))
|
||||
(setq x (/ x 2))
|
||||
(while (condition-case nil
|
||||
(> (expt 10.0 x) 0.0)
|
||||
(error nil))
|
||||
(while (ignore-errors (> (expt 10.0 x) 0.0))
|
||||
(setq x (1- x)))
|
||||
(+ x 2))
|
||||
"The smallest exponent which Calc will convert to an Emacs float.")
|
||||
|
|
@ -100,19 +90,18 @@ If this can't be done, return NIL."
|
|||
(let* ((xpon (+ (nth 2 x) (1- (math-numdigs (nth 1 x))))))
|
||||
(and (<= math-smallest-emacs-expt xpon)
|
||||
(<= xpon math-largest-emacs-expt)
|
||||
(condition-case nil
|
||||
(math-read-number
|
||||
(number-to-string
|
||||
(funcall fn
|
||||
(string-to-number
|
||||
(let
|
||||
((calc-number-radix 10)
|
||||
(calc-twos-complement-mode nil)
|
||||
(calc-float-format (list 'float calc-internal-prec))
|
||||
(calc-group-digits nil)
|
||||
(calc-point-char "."))
|
||||
(math-format-number (math-float x)))))))
|
||||
(error nil))))))
|
||||
(ignore-errors
|
||||
(math-read-number
|
||||
(number-to-string
|
||||
(funcall fn
|
||||
(string-to-number
|
||||
(let
|
||||
((calc-number-radix 10)
|
||||
(calc-twos-complement-mode nil)
|
||||
(calc-float-format (list 'float calc-internal-prec))
|
||||
(calc-group-digits nil)
|
||||
(calc-point-char "."))
|
||||
(math-format-number (math-float x))))))))))))
|
||||
|
||||
(defun calc-sqrt (arg)
|
||||
(interactive "P")
|
||||
|
|
@ -638,11 +627,11 @@ If this can't be done, return NIL."
|
|||
(defvar math-nrf-nf)
|
||||
(defvar math-nrf-nfm1)
|
||||
|
||||
(defun math-nth-root-float (a math-nrf-n &optional guess)
|
||||
(defun math-nth-root-float (a nrf-n &optional guess)
|
||||
(math-inexact-result)
|
||||
(math-with-extra-prec 1
|
||||
(let ((math-nrf-nf (math-float math-nrf-n))
|
||||
(math-nrf-nfm1 (math-float (1- math-nrf-n))))
|
||||
(let ((math-nrf-nf (math-float nrf-n))
|
||||
(math-nrf-nfm1 (math-float (1- nrf-n))))
|
||||
(math-nth-root-float-iter a (or guess
|
||||
(math-make-float
|
||||
1 (/ (+ (math-numdigs (nth 1 a))
|
||||
|
|
@ -665,11 +654,12 @@ If this can't be done, return NIL."
|
|||
;; math-nth-root-int.
|
||||
(defvar math-nri-n)
|
||||
|
||||
(defun math-nth-root-integer (a math-nri-n &optional guess) ; [I I S]
|
||||
(math-nth-root-int-iter a (or guess
|
||||
(math-scale-int 1 (/ (+ (math-numdigs a)
|
||||
(1- math-nri-n))
|
||||
math-nri-n)))))
|
||||
(defun math-nth-root-integer (a nri-n &optional guess) ; [I I S]
|
||||
(let ((math-nri-n nri-n))
|
||||
(math-nth-root-int-iter a (or guess
|
||||
(math-scale-int 1 (/ (+ (math-numdigs a)
|
||||
(1- nri-n))
|
||||
nri-n))))))
|
||||
|
||||
(defun math-nth-root-int-iter (a guess)
|
||||
(math-working "root" guess)
|
||||
|
|
@ -693,13 +683,13 @@ If this can't be done, return NIL."
|
|||
|
||||
;;;; Transcendental functions.
|
||||
|
||||
;;; All of these functions are defined on the complex plane.
|
||||
;;; (Branch cuts, etc. follow Steele's Common Lisp book.)
|
||||
;; All of these functions are defined on the complex plane.
|
||||
;; (Branch cuts, etc. follow Steele's Common Lisp book.)
|
||||
|
||||
;;; Most functions increase calc-internal-prec by 2 digits, then round
|
||||
;;; down afterward. "-raw" functions use the current precision, require
|
||||
;;; their arguments to be in float (or complex float) format, and always
|
||||
;;; work in radians (where applicable).
|
||||
;; Most functions increase calc-internal-prec by 2 digits, then round
|
||||
;; down afterward. "-raw" functions use the current precision, require
|
||||
;; their arguments to be in float (or complex float) format, and always
|
||||
;; work in radians (where applicable).
|
||||
|
||||
(defun math-to-radians (a) ; [N N]
|
||||
(cond ((eq (car-safe a) 'hms)
|
||||
|
|
@ -1126,9 +1116,9 @@ If this can't be done, return NIL."
|
|||
(math-div-float (cdr sc) (car sc)))))))
|
||||
|
||||
|
||||
;;; This could use a smarter method: Reduce x as in math-sin-raw, then
|
||||
;;; compute either sin(x) or cos(x), whichever is smaller, and compute
|
||||
;;; the other using the identity sin(x)^2 + cos(x)^2 = 1.
|
||||
;; This could use a smarter method: Reduce x as in math-sin-raw, then
|
||||
;; compute either sin(x) or cos(x), whichever is smaller, and compute
|
||||
;; the other using the identity sin(x)^2 + cos(x)^2 = 1.
|
||||
(defun math-sin-cos-raw (x) ; [F.F F] (result is (sin x . cos x))
|
||||
(cons (math-sin-raw x) (math-cos-raw x)))
|
||||
|
||||
|
|
@ -2072,7 +2062,7 @@ If this can't be done, return NIL."
|
|||
(put 'calcFunc-arctanh 'math-expandable t)
|
||||
|
||||
|
||||
;;; Convert A from HMS or degrees to radians.
|
||||
;; Convert A from HMS or degrees to radians.
|
||||
(defun calcFunc-rad (a) ; [R R] [Public]
|
||||
(cond ((or (Math-numberp a)
|
||||
(eq (car a) 'intv))
|
||||
|
|
@ -2089,7 +2079,7 @@ If this can't be done, return NIL."
|
|||
(t (list 'calcFunc-rad a))))
|
||||
(put 'calcFunc-rad 'math-expandable t)
|
||||
|
||||
;;; Convert A from HMS or radians to degrees.
|
||||
;; Convert A from HMS or radians to degrees.
|
||||
(defun calcFunc-deg (a) ; [R R] [Public]
|
||||
(cond ((or (Math-numberp a)
|
||||
(eq (car a) 'intv))
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calc-menu.el --- a menu for Calc
|
||||
;;; calc-menu.el --- a menu for Calc -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calc-misc.el --- miscellaneous functions for Calc
|
||||
;;; calc-misc.el --- miscellaneous functions for Calc -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -505,7 +505,7 @@ With argument 0, switch line point is in with line mark is in."
|
|||
;; 3 <-- mid-line = 3
|
||||
;; 4 <-- point
|
||||
;; 5 <-- bot-line = 5
|
||||
(dotimes (i mid-line)
|
||||
(dotimes (_ mid-line)
|
||||
(setq mid-cell old-top-list
|
||||
old-top-list (cdr old-top-list))
|
||||
(setcdr mid-cell new-top-list)
|
||||
|
|
@ -519,7 +519,7 @@ With argument 0, switch line point is in with line mark is in."
|
|||
;; 2
|
||||
;; 1
|
||||
(setq prev-mid-cell old-top-list)
|
||||
(dotimes (i (- bot-line mid-line))
|
||||
(dotimes (_ (- bot-line mid-line))
|
||||
(setq bot-cell old-top-list
|
||||
old-top-list (cdr old-top-list))
|
||||
(setcdr bot-cell new-top-list)
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calc-mode.el --- calculator modes for Calc
|
||||
;;; calc-mode.el --- calculator modes for Calc -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -424,8 +424,8 @@
|
|||
(t
|
||||
"Not recording mode changes permanently")))))
|
||||
|
||||
(defun calc-total-algebraic-mode (flag)
|
||||
(interactive "P")
|
||||
(defun calc-total-algebraic-mode (&optional _flag)
|
||||
(interactive)
|
||||
(calc-wrapper
|
||||
(if (eq calc-algebraic-mode 'total)
|
||||
(calc-algebraic-mode nil)
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calc-mtx.el --- matrix functions for Calc
|
||||
;;; calc-mtx.el --- matrix functions for Calc -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calc-nlfit.el --- nonlinear curve fitting for Calc
|
||||
;;; calc-nlfit.el --- nonlinear curve fitting for Calc -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -104,19 +104,19 @@
|
|||
(list 'vec C12 C22))))
|
||||
(list A B)))))
|
||||
|
||||
;;; The methods described by de Sousa require the cumulative data qdata
|
||||
;;; and the rates pdata. We will assume that we are given either
|
||||
;;; qdata and the corresponding times tdata, or pdata and the corresponding
|
||||
;;; tdata. The following two functions will find pdata or qdata,
|
||||
;;; given the other..
|
||||
;; The methods described by de Sousa require the cumulative data qdata
|
||||
;; and the rates pdata. We will assume that we are given either
|
||||
;; qdata and the corresponding times tdata, or pdata and the corresponding
|
||||
;; tdata. The following two functions will find pdata or qdata,
|
||||
;; given the other..
|
||||
|
||||
;;; First, given two lists; one of values q0, q1, ..., qn and one of
|
||||
;;; corresponding times t0, t1, ..., tn; return a list
|
||||
;;; p0, p1, ..., pn of the rates of change of the qi with respect to t.
|
||||
;;; p0 is the right hand derivative (q1 - q0)/(t1 - t0).
|
||||
;;; pn is the left hand derivative (qn - q(n-1))/(tn - t(n-1)).
|
||||
;;; The other pis are the averages of the two:
|
||||
;;; (1/2)((qi - q(i-1))/(ti - t(i-1)) + (q(i+1) - qi)/(t(i+1) - ti)).
|
||||
;; First, given two lists; one of values q0, q1, ..., qn and one of
|
||||
;; corresponding times t0, t1, ..., tn; return a list
|
||||
;; p0, p1, ..., pn of the rates of change of the qi with respect to t.
|
||||
;; p0 is the right hand derivative (q1 - q0)/(t1 - t0).
|
||||
;; pn is the left hand derivative (qn - q(n-1))/(tn - t(n-1)).
|
||||
;; The other pis are the averages of the two:
|
||||
;; (1/2)((qi - q(i-1))/(ti - t(i-1)) + (q(i+1) - qi)/(t(i+1) - ti)).
|
||||
|
||||
(defun math-nlfit-get-rates-from-cumul (tdata qdata)
|
||||
(let ((pdata (list
|
||||
|
|
@ -153,12 +153,12 @@
|
|||
pdata))
|
||||
(reverse pdata)))
|
||||
|
||||
;;; Next, given two lists -- one of rates p0, p1, ..., pn and one of
|
||||
;;; corresponding times t0, t1, ..., tn -- and an initial values q0,
|
||||
;;; return a list q0, q1, ..., qn of the cumulative values.
|
||||
;;; q0 is the initial value given.
|
||||
;;; For i>0, qi is computed using the trapezoid rule:
|
||||
;;; qi = q(i-1) + (1/2)(pi + p(i-1))(ti - t(i-1))
|
||||
;; Next, given two lists -- one of rates p0, p1, ..., pn and one of
|
||||
;; corresponding times t0, t1, ..., tn -- and an initial values q0,
|
||||
;; return a list q0, q1, ..., qn of the cumulative values.
|
||||
;; q0 is the initial value given.
|
||||
;; For i>0, qi is computed using the trapezoid rule:
|
||||
;; qi = q(i-1) + (1/2)(pi + p(i-1))(ti - t(i-1))
|
||||
|
||||
(defun math-nlfit-get-cumul-from-rates (tdata pdata q0)
|
||||
(let* ((qdata (list q0)))
|
||||
|
|
@ -177,16 +177,16 @@
|
|||
(setq tdata (cdr tdata)))
|
||||
(reverse qdata)))
|
||||
|
||||
;;; Given the qdata, pdata and tdata, find the parameters
|
||||
;;; a, b and c that fit q = a/(1+b*exp(c*t)).
|
||||
;;; a is found using the method described by de Sousa.
|
||||
;;; b and c are found using least squares on the linearization
|
||||
;;; log((a/q)-1) = log(b) + c*t
|
||||
;;; In some cases (where the logistic curve may well be the wrong
|
||||
;;; model), the computed a will be less than or equal to the maximum
|
||||
;;; value of q in qdata; in which case the above linearization won't work.
|
||||
;;; In this case, a will be replaced by a number slightly above
|
||||
;;; the maximum value of q.
|
||||
;; Given the qdata, pdata and tdata, find the parameters
|
||||
;; a, b and c that fit q = a/(1+b*exp(c*t)).
|
||||
;; a is found using the method described by de Sousa.
|
||||
;; b and c are found using least squares on the linearization
|
||||
;; log((a/q)-1) = log(b) + c*t
|
||||
;; In some cases (where the logistic curve may well be the wrong
|
||||
;; model), the computed a will be less than or equal to the maximum
|
||||
;; value of q in qdata; in which case the above linearization won't work.
|
||||
;; In this case, a will be replaced by a number slightly above
|
||||
;; the maximum value of q.
|
||||
|
||||
(defun math-nlfit-find-qmax (qdata pdata tdata)
|
||||
(let* ((ratios (math-map-binop 'math-div pdata qdata))
|
||||
|
|
@ -208,12 +208,12 @@
|
|||
(calcFunc-exp (nth 0 bandc))
|
||||
(nth 1 bandc))))
|
||||
|
||||
;;; Next, given the pdata and tdata, we can find the qdata if we know q0.
|
||||
;;; We first try to find q0, using the fact that when p takes on its largest
|
||||
;;; value, q is half of its maximum value. So we'll find the maximum value
|
||||
;;; of q given various q0, and use bisection to approximate the correct q0.
|
||||
;; Next, given the pdata and tdata, we can find the qdata if we know q0.
|
||||
;; We first try to find q0, using the fact that when p takes on its largest
|
||||
;; value, q is half of its maximum value. So we'll find the maximum value
|
||||
;; of q given various q0, and use bisection to approximate the correct q0.
|
||||
|
||||
;;; First, given pdata and tdata, find what half of qmax would be if q0=0.
|
||||
;; First, given pdata and tdata, find what half of qmax would be if q0=0.
|
||||
|
||||
(defun math-nlfit-find-qmaxhalf (pdata tdata)
|
||||
(let ((pmax (math-max-list (car pdata) (cdr pdata)))
|
||||
|
|
@ -231,7 +231,7 @@
|
|||
(setq tdata (cdr tdata)))
|
||||
qmh))
|
||||
|
||||
;;; Next, given pdata and tdata, approximate q0.
|
||||
;; Next, given pdata and tdata, approximate q0.
|
||||
|
||||
(defun math-nlfit-find-q0 (pdata tdata)
|
||||
(let* ((qhalf (math-nlfit-find-qmaxhalf pdata tdata))
|
||||
|
|
@ -250,7 +250,7 @@
|
|||
(setq q0 (math-add q0 qhalf)))
|
||||
(let* ((qmin (math-sub q0 qhalf))
|
||||
(qmax q0)
|
||||
(qt (math-nlfit-find-qmax
|
||||
(_qt (math-nlfit-find-qmax
|
||||
(mapcar
|
||||
(lambda (q) (math-add q0 q))
|
||||
qdata)
|
||||
|
|
@ -270,20 +270,20 @@
|
|||
(setq i (1+ i)))
|
||||
(math-mul '(float 5 -1) (math-add qmin qmax)))))
|
||||
|
||||
;;; To improve the approximations to the parameters, we can use
|
||||
;;; Marquardt method as described in Schwarz's book.
|
||||
;; To improve the approximations to the parameters, we can use
|
||||
;; Marquardt method as described in Schwarz's book.
|
||||
|
||||
;;; Small numbers used in the Givens algorithm
|
||||
;; Small numbers used in the Givens algorithm
|
||||
(defvar math-nlfit-delta '(float 1 -8))
|
||||
|
||||
(defvar math-nlfit-epsilon '(float 1 -5))
|
||||
|
||||
;;; Maximum number of iterations
|
||||
;; Maximum number of iterations
|
||||
(defvar math-nlfit-max-its 100)
|
||||
|
||||
;;; Next, we need some functions for dealing with vectors and
|
||||
;;; matrices. For convenience, we'll work with Emacs lists
|
||||
;;; as vectors, rather than Calc's vectors.
|
||||
;; Next, we need some functions for dealing with vectors and
|
||||
;; matrices. For convenience, we'll work with Emacs lists
|
||||
;; as vectors, rather than Calc's vectors.
|
||||
|
||||
(defun math-nlfit-set-elt (vec i x)
|
||||
(setcar (nthcdr (1- i) vec) x))
|
||||
|
|
@ -589,7 +589,7 @@
|
|||
(calcFunc-trn j) j))
|
||||
(calcFunc-inv j)))
|
||||
|
||||
(defun math-nlfit-get-sigmas (grad xlist pparms chisq)
|
||||
(defun math-nlfit-get-sigmas (grad xlist pparms _chisq)
|
||||
(let* ((sgs nil)
|
||||
(covar (math-nlfit-find-covar grad xlist pparms))
|
||||
(n (1- (length covar)))
|
||||
|
|
@ -664,6 +664,8 @@
|
|||
(calc-pop-push-record-list n prefix vals)
|
||||
(calc-handle-whys))
|
||||
|
||||
(defvar calc-curve-nvars)
|
||||
|
||||
(defun math-nlfit-fit-curve (fn grad solnexpr initparms &optional sdv)
|
||||
(calc-slow-wrapper
|
||||
(let* ((sdevv (or (eq sdv 'calcFunc-efit) (eq sdv 'calcFunc-xfit)))
|
||||
|
|
@ -678,7 +680,7 @@
|
|||
(calc-curve-varnames nil)
|
||||
(calc-curve-coefnames nil)
|
||||
(calc-curve-nvars 1)
|
||||
(fitvars (calc-get-fit-variables 1 3))
|
||||
(_fitvars (calc-get-fit-variables 1 3))
|
||||
(var (nth 1 calc-curve-varnames))
|
||||
(parms (cdr calc-curve-coefnames))
|
||||
(parmguess
|
||||
|
|
@ -763,7 +765,7 @@
|
|||
(calc-curve-varnames nil)
|
||||
(calc-curve-coefnames nil)
|
||||
(calc-curve-nvars 1)
|
||||
(fitvars (calc-get-fit-variables 1 2))
|
||||
(_fitvars (calc-get-fit-variables 1 2))
|
||||
(var (nth 1 calc-curve-varnames))
|
||||
(parms (cdr calc-curve-coefnames))
|
||||
(soln (list '* (nth 0 finalparms)
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calc-prog.el --- user programmability functions for Calc
|
||||
;;; calc-prog.el --- user programmability functions for Calc -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -111,10 +111,15 @@
|
|||
"Not reporting timing of commands"))))
|
||||
|
||||
(defun calc-pass-errors ()
|
||||
;; FIXME: This is broken at least since Emacs-26.
|
||||
;; AFAICT the immediate purpose of this code is to hack the
|
||||
;; `condition-case' in `calc-do' so it doesn't catch errors any
|
||||
;; more. I'm not sure why/whatfor this was designed, but I suspect
|
||||
;; that `condition-case-unless-debug' would cover the same needs.
|
||||
(interactive)
|
||||
;; The following two cases are for the new, optimizing byte compiler
|
||||
;; or the standard 18.57 byte compiler, respectively.
|
||||
(condition-case err
|
||||
(condition-case nil
|
||||
(let ((place (aref (nth 2 (nth 2 (symbol-function 'calc-do))) 15)))
|
||||
(or (memq (car-safe (car-safe place)) '(error xxxerror))
|
||||
(setq place (aref (nth 2 (nth 2 (symbol-function 'calc-do))) 27)))
|
||||
|
|
@ -165,6 +170,7 @@
|
|||
;; calc-user-define-composition and calc-finish-formula-edit,
|
||||
;; but is used by calc-fix-user-formula.
|
||||
(defvar calc-user-formula-alist)
|
||||
(defvar math-arglist) ; dynamically bound in all callers
|
||||
|
||||
(defun calc-user-define-formula ()
|
||||
(interactive)
|
||||
|
|
@ -328,7 +334,6 @@
|
|||
(setcdr kmap (cons (cons key cmd) (cdr kmap)))))))
|
||||
(message "")))
|
||||
|
||||
(defvar math-arglist) ; dynamically bound in all callers
|
||||
(defun calc-default-formula-arglist (form)
|
||||
(if (consp form)
|
||||
(if (eq (car form) 'var)
|
||||
|
|
@ -511,8 +516,9 @@
|
|||
;; is called (indirectly) by calc-read-parse-table.
|
||||
(defvar calc-lang)
|
||||
|
||||
(defun calc-write-parse-table (tab calc-lang)
|
||||
(let ((p tab))
|
||||
(defun calc-write-parse-table (tab lang)
|
||||
(let ((calc-lang lang)
|
||||
(p tab))
|
||||
(while p
|
||||
(calc-write-parse-table-part (car (car p)))
|
||||
(insert ":= "
|
||||
|
|
@ -551,8 +557,9 @@
|
|||
(insert " "))))
|
||||
(setq p (cdr p))))
|
||||
|
||||
(defun calc-read-parse-table (calc-buf calc-lang)
|
||||
(let ((tab nil))
|
||||
(defun calc-read-parse-table (calc-buf lang)
|
||||
(let ((calc-lang lang)
|
||||
(tab nil))
|
||||
(while (progn
|
||||
(skip-chars-forward "\n\t ")
|
||||
(not (eobp)))
|
||||
|
|
@ -860,7 +867,7 @@
|
|||
(defun calc-edit-macro-combine-digits ()
|
||||
"Put an entire sequence of digits on a single line."
|
||||
(let ((line (calc-edit-macro-command))
|
||||
curline)
|
||||
) ;; curline
|
||||
(goto-char (line-beginning-position))
|
||||
(kill-line 1)
|
||||
(while (string-equal (calc-edit-macro-command-type) "calcDigit-start")
|
||||
|
|
@ -1038,7 +1045,7 @@ Redefine the corresponding command."
|
|||
(let* ((cmd (cdr def))
|
||||
(fcmd (and cmd (symbolp cmd) (symbol-function cmd)))
|
||||
(func nil)
|
||||
(pt (point))
|
||||
;; (pt (point))
|
||||
(fill-column 70)
|
||||
(fill-prefix nil)
|
||||
str q-ok)
|
||||
|
|
@ -1945,8 +1952,9 @@ Redefine the corresponding command."
|
|||
;; by math-define-body.
|
||||
(defvar math-exp-env)
|
||||
|
||||
(defun math-define-body (body math-exp-env)
|
||||
(math-define-list body))
|
||||
(defun math-define-body (body exp-env)
|
||||
(let ((math-exp-env exp-env))
|
||||
(math-define-list body)))
|
||||
|
||||
(defun math-define-list (body &optional quote)
|
||||
(cond ((null body)
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calc-rewr.el --- rewriting functions for Calc
|
||||
;;; calc-rewr.el --- rewriting functions for Calc -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -142,7 +142,7 @@
|
|||
(calc-pop-push-record-list n "rwrt" (list expr)))
|
||||
(calc-handle-whys)))
|
||||
|
||||
(defun calc-match (pat &optional interactive)
|
||||
(defun calc-match (pat &optional _interactive)
|
||||
(interactive "sPattern: \np")
|
||||
(calc-slow-wrapper
|
||||
(let (n expr)
|
||||
|
|
@ -158,9 +158,9 @@
|
|||
(setq expr (calc-top-n 1)
|
||||
n 1))
|
||||
(or (math-vectorp expr) (error "Argument must be a vector"))
|
||||
(if (calc-is-inverse)
|
||||
(calc-enter-result n "mtcn" (math-match-patterns pat expr t))
|
||||
(calc-enter-result n "mtch" (math-match-patterns pat expr nil))))))
|
||||
(calc-enter-result n "mtcn"
|
||||
(math-match-patterns pat expr
|
||||
(not (not (calc-is-inverse))))))))
|
||||
|
||||
|
||||
(defvar math-mt-many)
|
||||
|
|
@ -169,8 +169,10 @@
|
|||
;; but is used by math-rewrite-phase
|
||||
(defvar math-rewrite-whole-expr)
|
||||
|
||||
(defun math-rewrite (math-rewrite-whole-expr rules &optional math-mt-many)
|
||||
(let* ((crules (math-compile-rewrites rules))
|
||||
(defun math-rewrite (rewrite-whole-expr rules &optional mt-many)
|
||||
(let* ((math-rewrite-whole-expr rewrite-whole-expr)
|
||||
(math-mt-many mt-many)
|
||||
(crules (math-compile-rewrites rules))
|
||||
(heads (math-rewrite-heads math-rewrite-whole-expr))
|
||||
(trace-buffer (get-buffer "*Trace*"))
|
||||
(calc-display-just 'center)
|
||||
|
|
@ -211,6 +213,8 @@
|
|||
":\n" fmt "\n"))))
|
||||
math-rewrite-whole-expr))
|
||||
|
||||
(defvar math-rewrite-phase 1)
|
||||
|
||||
(defun math-rewrite-phase (sched)
|
||||
(while (and sched (/= math-mt-many 0))
|
||||
(if (listp (car sched))
|
||||
|
|
@ -464,6 +468,8 @@
|
|||
;;; whole match the name v. Beware of circular structures!
|
||||
;;;
|
||||
|
||||
(defvar math-rewrite-whole nil)
|
||||
|
||||
(defun math-compile-patterns (pats)
|
||||
(if (and (eq (car-safe pats) 'var)
|
||||
(calc-var-value (nth 2 pats)))
|
||||
|
|
@ -485,7 +491,6 @@
|
|||
(cdr pats)
|
||||
(list pats)))))))))
|
||||
|
||||
(defvar math-rewrite-whole nil)
|
||||
(defvar math-make-import-list nil)
|
||||
|
||||
;; The variable math-import-list is local to part of math-compile-rewrites,
|
||||
|
|
@ -580,7 +585,7 @@
|
|||
(let ((rule-set nil)
|
||||
(all-heads nil)
|
||||
(nil-rules nil)
|
||||
(rule-count 0)
|
||||
;; (rule-count 0)
|
||||
(math-schedule nil)
|
||||
(math-iterations nil)
|
||||
(math-phases nil)
|
||||
|
|
@ -831,14 +836,16 @@
|
|||
(defvar math-rwcomp-subst-new-func)
|
||||
(defvar math-rwcomp-subst-old-func)
|
||||
|
||||
(defun math-rwcomp-substitute (expr math-rwcomp-subst-old math-rwcomp-subst-new)
|
||||
(if (and (eq (car-safe math-rwcomp-subst-old) 'var)
|
||||
(memq (car-safe math-rwcomp-subst-new) '(var calcFunc-lambda)))
|
||||
(let ((math-rwcomp-subst-old-func (math-var-to-calcFunc math-rwcomp-subst-old))
|
||||
(math-rwcomp-subst-new-func (math-var-to-calcFunc math-rwcomp-subst-new)))
|
||||
(defun math-rwcomp-substitute (expr rwcomp-subst-old rwcomp-subst-new)
|
||||
(let ((math-rwcomp-subst-old rwcomp-subst-old)
|
||||
(math-rwcomp-subst-new rwcomp-subst-new))
|
||||
(if (and (eq (car-safe rwcomp-subst-old) 'var)
|
||||
(memq (car-safe rwcomp-subst-new) '(var calcFunc-lambda)))
|
||||
(let ((math-rwcomp-subst-old-func (math-var-to-calcFunc rwcomp-subst-old))
|
||||
(math-rwcomp-subst-new-func (math-var-to-calcFunc rwcomp-subst-new)))
|
||||
(math-rwcomp-subst-rec expr))
|
||||
(let ((math-rwcomp-subst-old-func nil))
|
||||
(math-rwcomp-subst-rec expr))))
|
||||
(math-rwcomp-subst-rec expr)))))
|
||||
|
||||
(defun math-rwcomp-subst-rec (expr)
|
||||
(cond ((equal expr math-rwcomp-subst-old) math-rwcomp-subst-new)
|
||||
|
|
@ -1452,8 +1459,6 @@
|
|||
,form
|
||||
(setcar rules orig))))
|
||||
|
||||
(defvar math-rewrite-phase 1)
|
||||
|
||||
;; The variable math-apply-rw-regs is local to math-apply-rewrites,
|
||||
;; but is used by math-rwapply-replace-regs and math-rwapply-reg-looks-negp
|
||||
;; which are called by math-apply-rewrites.
|
||||
|
|
@ -1463,11 +1468,12 @@
|
|||
;; but is used by math-rwapply-remember.
|
||||
(defvar math-apply-rw-ruleset)
|
||||
|
||||
(defun math-apply-rewrites (expr rules &optional heads math-apply-rw-ruleset)
|
||||
(defun math-apply-rewrites (expr rules &optional heads apply-rw-ruleset)
|
||||
(and
|
||||
(setq rules (cdr (or (assq (car-safe expr) rules)
|
||||
(assq nil rules))))
|
||||
(let ((result nil)
|
||||
(let ((math-apply-rw-ruleset apply-rw-ruleset)
|
||||
(result nil)
|
||||
op math-apply-rw-regs inst part pc mark btrack
|
||||
(tracing math-rwcomp-tracing)
|
||||
(phase math-rewrite-phase))
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calc-rules.el --- rules for simplifying algebraic expressions in Calc
|
||||
;;; calc-rules.el --- rules for simplifying algebraic expressions in Calc -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calc-sel.el --- data selection functions for Calc
|
||||
;;; calc-sel.el --- data selection functions for Calc -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -146,7 +146,8 @@
|
|||
(defvar calc-fnp-op)
|
||||
(defvar calc-fnp-num)
|
||||
|
||||
(defun calc-find-nth-part (expr calc-fnp-num)
|
||||
(defun calc-find-nth-part (expr fnp-num)
|
||||
(let ((calc-fnp-num fnp-num))
|
||||
(if (and calc-assoc-selections
|
||||
(assq (car-safe expr) calc-assoc-ops))
|
||||
(let (calc-fnp-op)
|
||||
|
|
@ -154,7 +155,7 @@
|
|||
(if (eq (car-safe expr) 'intv)
|
||||
(and (>= calc-fnp-num 1) (<= calc-fnp-num 2) (nth (1+ calc-fnp-num) expr))
|
||||
(and (not (Math-primp expr)) (>= calc-fnp-num 1) (< calc-fnp-num (length expr))
|
||||
(nth calc-fnp-num expr)))))
|
||||
(nth calc-fnp-num expr))))))
|
||||
|
||||
(defun calc-find-nth-part-rec (expr) ; uses num, op
|
||||
(or (if (and (setq calc-fnp-op (assq (car-safe (nth 1 expr)) calc-assoc-ops))
|
||||
|
|
@ -381,7 +382,7 @@
|
|||
;; (if (or (< num 1) (> num (calc-stack-size)))
|
||||
;; (error "Cursor must be positioned on a stack element"))
|
||||
(let* ((entry (calc-top num 'entry))
|
||||
ww w)
|
||||
) ;; ww w
|
||||
(or (equal entry calc-selection-cache-entry)
|
||||
(progn
|
||||
(setcar entry (calc-encase-atoms (car entry)))
|
||||
|
|
@ -481,8 +482,9 @@
|
|||
(defvar calc-rsf-old)
|
||||
(defvar calc-rsf-new)
|
||||
|
||||
(defun calc-replace-sub-formula (expr calc-rsf-old calc-rsf-new)
|
||||
(setq calc-rsf-new (calc-encase-atoms calc-rsf-new))
|
||||
(defun calc-replace-sub-formula (expr rsf-old rsf-new)
|
||||
(let ((calc-rsf-old rsf-old)
|
||||
(calc-rsf-new (calc-encase-atoms rsf-new))))
|
||||
(calc-replace-sub-formula-rec expr))
|
||||
|
||||
(defun calc-replace-sub-formula-rec (expr)
|
||||
|
|
@ -671,7 +673,7 @@
|
|||
(entry (calc-top num 'entry))
|
||||
(expr (car entry))
|
||||
(sel (or (calc-auto-selection entry) expr))
|
||||
alg)
|
||||
) ;; alg
|
||||
(let ((str (math-showing-full-precision
|
||||
(math-format-nice-expr sel (frame-width)))))
|
||||
(calc-edit-mode (list 'calc-finish-selection-edit
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calc-stat.el --- statistical functions for Calc
|
||||
;;; calc-stat.el --- statistical functions for Calc -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calc-store.el --- value storage functions for Calc
|
||||
;;; calc-store.el --- value storage functions for Calc -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -184,10 +184,11 @@
|
|||
(defvar calc-read-var-name-history nil
|
||||
"History for reading variable names.")
|
||||
|
||||
(defun calc-read-var-name (prompt &optional calc-store-opers)
|
||||
(defun calc-read-var-name (prompt &optional store-opers)
|
||||
(setq calc-given-value nil
|
||||
calc-aborted-prefix nil)
|
||||
(let ((var (concat
|
||||
(let* ((calc-store-opers store-opers)
|
||||
(var (concat
|
||||
"var-"
|
||||
(let ((minibuffer-completion-table
|
||||
(mapcar (lambda (x) (substring x 4))
|
||||
|
|
@ -504,7 +505,7 @@
|
|||
(calc-wrapper
|
||||
(or var (setq var (calc-read-var-name "Declare: " 0)))
|
||||
(or var (setq var 'var-All))
|
||||
(let* (dp decl def row rp)
|
||||
(let* (dp decl row rp) ;; def
|
||||
(or (and (calc-var-value 'var-Decls)
|
||||
(eq (car-safe var-Decls) 'vec))
|
||||
(setq var-Decls (list 'vec)))
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calc-stuff.el --- miscellaneous functions for Calc
|
||||
;;; calc-stuff.el --- miscellaneous functions for Calc -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -273,8 +273,9 @@ With a prefix, push that prefix as a number onto the stack."
|
|||
;; math-map-over-constants.
|
||||
(defvar math-moc-func)
|
||||
|
||||
(defun math-map-over-constants (math-moc-func expr)
|
||||
(math-map-over-constants-rec expr))
|
||||
(defun math-map-over-constants (moc-func expr)
|
||||
(let ((math-moc-func moc-func))
|
||||
(math-map-over-constants-rec expr)))
|
||||
|
||||
(defun math-map-over-constants-rec (expr)
|
||||
(cond ((or (Math-primp expr)
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calc-trail.el --- functions for manipulating the Calc "trail"
|
||||
;;; calc-trail.el --- functions for manipulating the Calc "trail" -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calc-undo.el --- undo functions for Calc
|
||||
;;; calc-undo.el --- undo functions for Calc -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calc-vec.el --- vector functions for Calc
|
||||
;;; calc-vec.el --- vector functions for Calc -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -1111,18 +1111,20 @@
|
|||
;; by calcFunc-grade and calcFunc-rgrade.
|
||||
(defvar math-grade-vec)
|
||||
|
||||
(defun calcFunc-grade (math-grade-vec)
|
||||
(if (math-vectorp math-grade-vec)
|
||||
(let* ((len (1- (length math-grade-vec))))
|
||||
(cons 'vec (sort (cdr (calcFunc-index len)) 'math-grade-beforep)))
|
||||
(math-reject-arg math-grade-vec 'vectorp)))
|
||||
(defun calcFunc-grade (grade-vec)
|
||||
(if (math-vectorp grade-vec)
|
||||
(let* ((math-grade-vec grade-vec)
|
||||
(len (1- (length grade-vec))))
|
||||
(cons 'vec (sort (cdr (calcFunc-index len)) #'math-grade-beforep)))
|
||||
(math-reject-arg grade-vec #'vectorp)))
|
||||
|
||||
(defun calcFunc-rgrade (math-grade-vec)
|
||||
(if (math-vectorp math-grade-vec)
|
||||
(let* ((len (1- (length math-grade-vec))))
|
||||
(defun calcFunc-rgrade (grade-vec)
|
||||
(if (math-vectorp grade-vec)
|
||||
(let* ((math-grade-vec grade-vec)
|
||||
(len (1- (length grade-vec))))
|
||||
(cons 'vec (nreverse (sort (cdr (calcFunc-index len))
|
||||
'math-grade-beforep))))
|
||||
(math-reject-arg math-grade-vec 'vectorp)))
|
||||
#'math-grade-beforep))))
|
||||
(math-reject-arg grade-vec #'vectorp)))
|
||||
|
||||
(defun math-grade-beforep (i j)
|
||||
(math-beforep (nth i math-grade-vec) (nth j math-grade-vec)))
|
||||
|
|
@ -1556,7 +1558,8 @@ of two matrices is a matrix."
|
|||
(defvar math-exp-keep-spaces)
|
||||
(defvar math-expr-data)
|
||||
|
||||
(defun math-read-brackets (space-sep math-rb-close)
|
||||
(defun math-read-brackets (space-sep rb-close)
|
||||
(let ((math-rb-close rb-close))
|
||||
(and space-sep (setq space-sep (not (math-check-for-commas))))
|
||||
(math-read-token)
|
||||
(while (eq math-exp-token 'space)
|
||||
|
|
@ -1624,7 +1627,7 @@ of two matrices is a matrix."
|
|||
(throw 'syntax "Expected `]'")))
|
||||
(or (eq math-exp-token 'end)
|
||||
(math-read-token))
|
||||
vals)))
|
||||
vals))))
|
||||
|
||||
(defun math-check-for-commas (&optional balancing)
|
||||
(let ((count 0)
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calc-yank.el --- kill-ring functionality for Calc
|
||||
;;; calc-yank.el --- kill-ring functionality for Calc -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -401,7 +401,7 @@ Interactively, reads the register using `register-read-with-preview'."
|
|||
(let* ((from-buffer (current-buffer))
|
||||
(calc-was-started (get-buffer-window "*Calculator*"))
|
||||
(single nil)
|
||||
data vals pos)
|
||||
data vals) ;; pos
|
||||
(if arg
|
||||
(if (consp arg)
|
||||
(setq single t)
|
||||
|
|
@ -776,7 +776,7 @@ To cancel the edit, simply kill the *Calc Edit* buffer."
|
|||
(error "Original calculator buffer has been corrupted")))
|
||||
(goto-char calc-edit-top)
|
||||
(if (buffer-modified-p)
|
||||
(eval calc-edit-handler))
|
||||
(eval calc-edit-handler t))
|
||||
(if (and one-window (not (one-window-p t)))
|
||||
(delete-window))
|
||||
(if (get-buffer-window return)
|
||||
|
|
|
|||
|
|
@ -2313,7 +2313,7 @@ the United States."
|
|||
((eq last-command-event ?@) "0@ ")
|
||||
(t (char-to-string last-command-event))))
|
||||
|
||||
(defvar calc-buffer)
|
||||
(defvar calc-buffer nil)
|
||||
(defvar calc-prev-char)
|
||||
(defvar calc-prev-prev-char)
|
||||
(defvar calc-digit-value)
|
||||
|
|
@ -2353,7 +2353,7 @@ the United States."
|
|||
(defun calcDigit-nondigit ()
|
||||
(interactive)
|
||||
;; Exercise for the reader: Figure out why this is a good precaution!
|
||||
(or (boundp 'calc-buffer)
|
||||
(or calc-buffer
|
||||
(use-local-map minibuffer-local-map))
|
||||
(let ((str (minibuffer-contents)))
|
||||
(setq calc-digit-value (with-current-buffer calc-buffer
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calcalg2.el --- more algebraic functions for Calc
|
||||
;;; calcalg2.el --- more algebraic functions for Calc -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -333,8 +333,10 @@
|
|||
(setq n (1+ n)))
|
||||
accum))))))
|
||||
|
||||
(defun calcFunc-deriv (expr math-deriv-var &optional deriv-value math-deriv-symb)
|
||||
(let* ((math-deriv-total nil)
|
||||
(defun calcFunc-deriv (expr deriv-var &optional deriv-value deriv-symb)
|
||||
(let* ((math-deriv-var deriv-var)
|
||||
(math-deriv-symb deriv-symb)
|
||||
(math-deriv-total nil)
|
||||
(res (catch 'math-deriv (math-derivative expr))))
|
||||
(or (eq (car-safe res) 'calcFunc-deriv)
|
||||
(null res)
|
||||
|
|
@ -344,9 +346,11 @@
|
|||
(math-expr-subst res math-deriv-var deriv-value)
|
||||
res))))
|
||||
|
||||
(defun calcFunc-tderiv (expr math-deriv-var &optional deriv-value math-deriv-symb)
|
||||
(defun calcFunc-tderiv (expr deriv-var &optional deriv-value deriv-symb)
|
||||
(math-setup-declarations)
|
||||
(let* ((math-deriv-total t)
|
||||
(let* ((math-deriv-var deriv-var)
|
||||
(math-deriv-symb deriv-symb)
|
||||
(math-deriv-total t)
|
||||
(res (catch 'math-deriv (math-derivative expr))))
|
||||
(or (eq (car-safe res) 'calcFunc-tderiv)
|
||||
(null res)
|
||||
|
|
@ -363,10 +367,10 @@
|
|||
(function (lambda (u) (math-div 1 (math-mul 2 (list 'calcFunc-sqrt u))))))
|
||||
|
||||
(put 'calcFunc-deg\' 'math-derivative-1
|
||||
(function (lambda (u) (math-div-float '(float 18 1) (math-pi)))))
|
||||
(function (lambda (_) (math-div-float '(float 18 1) (math-pi)))))
|
||||
|
||||
(put 'calcFunc-rad\' 'math-derivative-1
|
||||
(function (lambda (u) (math-pi-over-180))))
|
||||
(function (lambda (_) (math-pi-over-180))))
|
||||
|
||||
(put 'calcFunc-ln\' 'math-derivative-1
|
||||
(function (lambda (u) (math-div 1 u))))
|
||||
|
|
@ -1079,8 +1083,9 @@
|
|||
;; math-integ-try-substitutions.
|
||||
(defvar math-integ-expr)
|
||||
|
||||
(defun math-do-integral-methods (math-integ-expr)
|
||||
(let ((math-so-far math-integ-var-list-list)
|
||||
(defun math-do-integral-methods (integ-expr)
|
||||
(let ((math-integ-expr integ-expr)
|
||||
(math-so-far math-integ-var-list-list)
|
||||
rat-in)
|
||||
|
||||
;; Integration by substitution, for various likely sub-expressions.
|
||||
|
|
@ -1195,10 +1200,11 @@
|
|||
(defvar math-good-parts)
|
||||
|
||||
|
||||
(defun math-integ-try-parts (expr &optional math-good-parts)
|
||||
(defun math-integ-try-parts (expr &optional good-parts)
|
||||
;; Integration by parts:
|
||||
;; integ(f(x) g(x),x) = f(x) h(x) - integ(h(x) f'(x),x)
|
||||
;; where h(x) = integ(g(x),x).
|
||||
(let ((math-good-parts good-parts))
|
||||
(or (let ((exp (calcFunc-expand expr)))
|
||||
(and (not (equal exp expr))
|
||||
(math-integral exp)))
|
||||
|
|
@ -1219,14 +1225,14 @@
|
|||
(and (eq (car expr) '^)
|
||||
(math-integrate-by-parts (math-pow (nth 1 expr)
|
||||
(math-sub (nth 2 expr) 1))
|
||||
(nth 1 expr)))))
|
||||
(nth 1 expr))))))
|
||||
|
||||
(defun math-integrate-by-parts (u vprime)
|
||||
(let ((math-integ-level (if (or math-good-parts
|
||||
(math-polynomial-p u math-integ-var))
|
||||
math-integ-level
|
||||
(1- math-integ-level)))
|
||||
(math-doing-parts t)
|
||||
;; (math-doing-parts t) ;Unused
|
||||
v temp)
|
||||
(and (>= math-integ-level 0)
|
||||
(unwind-protect
|
||||
|
|
@ -1532,7 +1538,7 @@
|
|||
(math-any-substs t)
|
||||
(math-enable-subst nil)
|
||||
(math-prev-parts-v nil)
|
||||
(math-doing-parts nil)
|
||||
;; (math-doing-parts nil) ;Unused
|
||||
(math-good-parts nil)
|
||||
(res
|
||||
(if trace-buffer
|
||||
|
|
@ -1883,7 +1889,10 @@
|
|||
(defvar calc-high)
|
||||
(defvar math-var)
|
||||
|
||||
(defun calcFunc-table (expr math-var &optional calc-low calc-high step)
|
||||
(defun calcFunc-table (expr var &optional low high step)
|
||||
(let ((math-var var)
|
||||
(calc-high high)
|
||||
(calc-low low))
|
||||
(or calc-low
|
||||
(setq calc-low '(neg (var inf var-inf)) calc-high '(var inf var-inf)))
|
||||
(or calc-high (setq calc-high calc-low calc-low 1))
|
||||
|
|
@ -1894,8 +1903,7 @@
|
|||
(let ((known (+ (if (Math-objectp calc-low) 1 0)
|
||||
(if (Math-objectp calc-high) 1 0)
|
||||
(if (or (null step) (Math-objectp step)) 1 0)))
|
||||
(count '(var inf var-inf))
|
||||
vec)
|
||||
(count '(var inf var-inf))) ;; vec
|
||||
(or (= known 2) ; handy optimization
|
||||
(equal calc-high '(var inf var-inf))
|
||||
(progn
|
||||
|
|
@ -1906,6 +1914,7 @@
|
|||
(setq count (math-trunc count)))))
|
||||
(if (Math-negp count)
|
||||
(setq count -1))
|
||||
(defvar var-DUMMY)
|
||||
(if (integerp count)
|
||||
(let ((var-DUMMY nil)
|
||||
(vec math-tabulate-initial)
|
||||
|
|
@ -1939,7 +1948,7 @@
|
|||
(and (not (and (equal calc-low '(neg (var inf var-inf)))
|
||||
(equal calc-high '(var inf var-inf))))
|
||||
(list calc-low calc-high))
|
||||
(and step (list step))))))
|
||||
(and step (list step)))))))
|
||||
|
||||
(defun math-scan-for-limits (x)
|
||||
(cond ((Math-primp x))
|
||||
|
|
@ -1951,8 +1960,10 @@
|
|||
(high-val (math-solve-for (nth 2 x) (1- (length (nth 1 x)))
|
||||
math-var nil))
|
||||
temp)
|
||||
(and low-val (math-realp low-val)
|
||||
high-val (math-realp high-val))
|
||||
;; FIXME: The below is a no-op, but I suspect its result
|
||||
;; was meant to be used, tho I don't know what for.
|
||||
;; (and low-val (math-realp low-val)
|
||||
;; high-val (math-realp high-val))
|
||||
(and (Math-lessp high-val low-val)
|
||||
(setq temp low-val low-val high-val high-val temp))
|
||||
(setq calc-low (math-max calc-low (math-ceiling low-val))
|
||||
|
|
@ -2361,8 +2372,11 @@
|
|||
(defvar math-try-solve-sign)
|
||||
|
||||
(defun math-try-solve-for
|
||||
(math-solve-lhs math-solve-rhs &optional math-try-solve-sign no-poly)
|
||||
(let (math-t1 math-t2 math-t3)
|
||||
(solve-lhs solve-rhs &optional try-solve-sign no-poly)
|
||||
(let ((math-solve-lhs solve-lhs)
|
||||
(math-solve-rhs solve-rhs)
|
||||
(math-try-solve-sign try-solve-sign)
|
||||
math-t1 math-t2 math-t3)
|
||||
(cond ((equal math-solve-lhs math-solve-var)
|
||||
(setq math-solve-sign math-try-solve-sign)
|
||||
(if (eq math-solve-full 'all)
|
||||
|
|
@ -2721,14 +2735,17 @@
|
|||
(cons 'vec d)
|
||||
(math-reject-arg expr "Expected a polynomial"))))
|
||||
|
||||
(defun math-decompose-poly (math-solve-lhs math-solve-var degree sub-rhs)
|
||||
(let ((math-solve-rhs (or sub-rhs 1))
|
||||
(defun math-decompose-poly (solve-lhs solve-var degree sub-rhs)
|
||||
(let ((math-solve-lhs solve-lhs)
|
||||
(math-solve-var solve-var)
|
||||
(math-solve-rhs (or sub-rhs 1))
|
||||
math-t1 math-t2 math-t3)
|
||||
(setq math-t2 (math-polynomial-base
|
||||
math-solve-lhs
|
||||
(function
|
||||
(lambda (math-solve-b)
|
||||
(let ((math-poly-neg-powers '(1))
|
||||
(lambda (solve-b)
|
||||
(let ((math-solve-b solve-b)
|
||||
(math-poly-neg-powers '(1))
|
||||
(math-poly-mult-powers nil)
|
||||
(math-poly-frac-powers 1)
|
||||
(math-poly-exp-base t))
|
||||
|
|
@ -2964,7 +2981,7 @@
|
|||
(math-poly-integer-root (car roots))
|
||||
(setq roots (cdr roots)))
|
||||
(list math-int-factors (nreverse math-int-coefs) math-int-scale))
|
||||
(let ((vec nil) res)
|
||||
(let ((vec nil)) ;; res
|
||||
(while roots
|
||||
(let ((root (car roots))
|
||||
(math-solve-full (and math-solve-full 'all)))
|
||||
|
|
@ -3109,7 +3126,7 @@
|
|||
(iters 0)
|
||||
(m (1- (length p)))
|
||||
(try-newt (not polish))
|
||||
(tried-newt nil)
|
||||
;; (tried-newt nil)
|
||||
b d f x1 dx dxold)
|
||||
(while
|
||||
(and (or (< (setq iters (1+ iters)) 50)
|
||||
|
|
@ -3146,7 +3163,7 @@
|
|||
(math-lessp (math-abs-approx dx)
|
||||
(calcFunc-scf (math-abs-approx x) -3)))
|
||||
(let ((newt (math-poly-newton-root p x1 7)))
|
||||
(setq tried-newt t
|
||||
(setq ;; tried-newt t
|
||||
try-newt nil)
|
||||
(if (math-zerop (cdr newt))
|
||||
(setq x (car newt) x1 x)
|
||||
|
|
@ -3160,7 +3177,8 @@
|
|||
(math-nearly-equal x x1))))
|
||||
(let ((cdx (math-abs-approx dx)))
|
||||
(setq x x1
|
||||
tried-newt nil)
|
||||
;; tried-newt nil
|
||||
)
|
||||
(prog1
|
||||
(or (<= iters 6)
|
||||
(math-lessp cdx dxold)
|
||||
|
|
@ -3227,7 +3245,9 @@
|
|||
;; and math-solve-system-rec, but is used by math-solve-system-subst.
|
||||
(defvar math-solve-simplifying)
|
||||
|
||||
(defun math-solve-system (exprs math-solve-vars math-solve-full)
|
||||
(defun math-solve-system (exprs solve-vars solve-full)
|
||||
(let ((math-solve-vars solve-vars)
|
||||
(math-solve-full solve-full))
|
||||
(setq exprs (mapcar 'list (if (Math-vectorp exprs)
|
||||
(cdr exprs)
|
||||
(list exprs)))
|
||||
|
|
@ -3237,7 +3257,7 @@
|
|||
(or (let ((math-solve-simplifying nil))
|
||||
(math-solve-system-rec exprs math-solve-vars nil))
|
||||
(let ((math-solve-simplifying t))
|
||||
(math-solve-system-rec exprs math-solve-vars nil))))
|
||||
(math-solve-system-rec exprs math-solve-vars nil)))))
|
||||
|
||||
;;; The following backtracking solver works by choosing a variable
|
||||
;;; and equation, and trying to solve the equation for the variable.
|
||||
|
|
@ -3437,10 +3457,12 @@
|
|||
(if (memq (car expr) '(* /))
|
||||
(math-looks-evenp (nth 1 expr)))))
|
||||
|
||||
(defun math-solve-for (lhs rhs math-solve-var math-solve-full &optional sign)
|
||||
(if (math-expr-contains rhs math-solve-var)
|
||||
(math-solve-for (math-sub lhs rhs) 0 math-solve-var math-solve-full)
|
||||
(and (math-expr-contains lhs math-solve-var)
|
||||
(defun math-solve-for (lhs rhs solve-var solve-full &optional sign)
|
||||
(let ((math-solve-var solve-var)
|
||||
(math-solve-full solve-full))
|
||||
(if (math-expr-contains rhs solve-var)
|
||||
(math-solve-for (math-sub lhs rhs) 0 solve-var solve-full)
|
||||
(and (math-expr-contains lhs solve-var)
|
||||
(math-with-extra-prec 1
|
||||
(let* ((math-poly-base-variable math-solve-var)
|
||||
(res (math-try-solve-for lhs rhs sign)))
|
||||
|
|
@ -3462,7 +3484,7 @@
|
|||
(format
|
||||
"*Omitted %d complex solutions"
|
||||
(- old-len new-len)))))))
|
||||
res)))))
|
||||
res))))))
|
||||
|
||||
(defun math-solve-eqn (expr var full)
|
||||
(if (memq (car-safe expr) '(calcFunc-neq calcFunc-lt calcFunc-gt
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calcalg3.el --- more algebraic functions for Calc
|
||||
;;; calcalg3.el --- more algebraic functions for Calc -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -120,18 +120,24 @@
|
|||
(defvar calc-curve-fit-history nil
|
||||
"History for calc-curve-fit.")
|
||||
|
||||
(defun calc-curve-fit (arg &optional calc-curve-model
|
||||
calc-curve-coefnames calc-curve-varnames)
|
||||
(defvar calc-graph-no-auto-view)
|
||||
(defvar calc-fit-to-trail nil)
|
||||
|
||||
(defun calc-curve-fit (arg &optional curve-model
|
||||
curve-coefnames curve-varnames)
|
||||
(interactive "P")
|
||||
(calc-slow-wrapper
|
||||
(setq calc-aborted-prefix nil)
|
||||
(let ((func (if (calc-is-inverse) 'calcFunc-xfit
|
||||
(let ((calc-curve-model curve-model)
|
||||
(calc-curve-coefnames curve-coefnames)
|
||||
(calc-curve-varnames curve-varnames)
|
||||
(func (if (calc-is-inverse) 'calcFunc-xfit
|
||||
(if (calc-is-hyperbolic) 'calcFunc-efit
|
||||
'calcFunc-fit)))
|
||||
key (which 0)
|
||||
(nonlinear nil)
|
||||
(plot nil)
|
||||
n calc-curve-nvars temp data
|
||||
n calc-curve-nvars data ;; temp
|
||||
(homog nil)
|
||||
(msgs '( "(Press ? for help)"
|
||||
"1 = linear or multilinear"
|
||||
|
|
@ -321,7 +327,7 @@
|
|||
(calc-get-fit-variables 1 (1- (length calc-curve-coefnames))
|
||||
(and homog 1)))
|
||||
((memq key '(?\$ ?\' ?u ?U))
|
||||
(let* ((defvars nil)
|
||||
(let* (;; (defvars nil)
|
||||
(record-entry nil))
|
||||
(if (eq key ?\')
|
||||
(let* ((calc-dollar-values calc-arg-values)
|
||||
|
|
@ -708,7 +714,7 @@
|
|||
"*Unable to find a sign change in this interval"))))
|
||||
|
||||
;;; "rtbis" (but we should be using Brent's method)
|
||||
(defun math-bisect-root (expr low vlow high vhigh)
|
||||
(defun math-bisect-root (expr low _vlow high vhigh)
|
||||
(let ((step (math-sub-float high low))
|
||||
(pos (Math-posp vhigh))
|
||||
var-DUMMY
|
||||
|
|
@ -726,7 +732,8 @@
|
|||
(setq high mid
|
||||
vhigh vmid)
|
||||
(setq low mid
|
||||
vlow vmid)))
|
||||
;; vlow vmid
|
||||
)))
|
||||
(list 'vec mid vmid)))
|
||||
|
||||
;;; "mnewt"
|
||||
|
|
@ -758,7 +765,8 @@
|
|||
(list 'vec next expr-val))))
|
||||
|
||||
|
||||
(defun math-find-root (expr var guess math-root-widen)
|
||||
(defun math-find-root (expr var guess root-widen)
|
||||
(let ((math-root-widen root-widen))
|
||||
(if (eq (car-safe expr) 'vec)
|
||||
(let ((n (1- (length expr)))
|
||||
(calc-symbolic-mode nil)
|
||||
|
|
@ -871,7 +879,7 @@
|
|||
(not (Math-numberp vlow))
|
||||
(not (Math-numberp vhigh)))
|
||||
(math-search-root expr deriv low vlow high vhigh)
|
||||
(math-bisect-root expr low vlow high vhigh))))))))))
|
||||
(math-bisect-root expr low vlow high vhigh)))))))))))
|
||||
|
||||
(defun calcFunc-root (expr var guess)
|
||||
(math-find-root expr var guess nil))
|
||||
|
|
@ -1019,7 +1027,7 @@
|
|||
math-min-or-max))))))
|
||||
|
||||
;;; "brent"
|
||||
(defun math-brent-min (expr prec a va x vx b vb)
|
||||
(defun math-brent-min (expr prec a _va x vx b _vb)
|
||||
(let ((iters (+ 20 (* 5 prec)))
|
||||
(w x)
|
||||
(vw vx)
|
||||
|
|
@ -1181,7 +1189,7 @@
|
|||
(list 'calcFunc-mrow '(var line-p line-p) (1+ m)))))
|
||||
(math-evaluate-expr expr)))
|
||||
|
||||
(defun math-line-min (f1dim line-p line-xi n prec)
|
||||
(defun math-line-min (f1dim line-p line-xi _n prec)
|
||||
(let* ((var-DUMMY nil)
|
||||
(expr (math-evaluate-expr f1dim))
|
||||
(params (math-widen-min expr '(float 0 0) '(float 1 0)))
|
||||
|
|
@ -1195,7 +1203,7 @@
|
|||
(n 0)
|
||||
(var-DUMMY nil)
|
||||
(isvec (math-vectorp var))
|
||||
g guesses)
|
||||
guesses) ;; g
|
||||
(or (math-vectorp var)
|
||||
(setq var (list 'vec var)))
|
||||
(or (math-vectorp guess)
|
||||
|
|
@ -1493,7 +1501,8 @@
|
|||
|
||||
(defun math-ninteg-midpoint (expr lo hi mode) ; uses "math-ninteg-temp"
|
||||
(if (eq mode 'inf)
|
||||
(let ((math-infinite-mode t) temp)
|
||||
(let (;; (math-infinite-mode t) ;Unused!
|
||||
temp)
|
||||
(setq temp (math-div 1 lo)
|
||||
lo (math-div 1 hi)
|
||||
hi temp)))
|
||||
|
|
@ -1547,7 +1556,6 @@
|
|||
(setq math-dummy-counter (1+ math-dummy-counter))))
|
||||
|
||||
(defvar math-in-fit 0)
|
||||
(defvar calc-fit-to-trail nil)
|
||||
|
||||
(defun calcFunc-fit (expr vars &optional coefs data)
|
||||
(let ((math-in-fit 10))
|
||||
|
|
@ -1573,6 +1581,7 @@
|
|||
(defvar math-fit-new-coefs)
|
||||
|
||||
(defun math-general-fit (expr vars coefs data mode)
|
||||
(defvar var-YVAL) (defvar var-YVALX)
|
||||
(let ((calc-simplify-mode nil)
|
||||
(math-dummy-counter math-dummy-counter)
|
||||
(math-in-fit 1)
|
||||
|
|
@ -1591,7 +1600,7 @@
|
|||
(weights nil)
|
||||
(var-YVAL nil) (var-YVALX nil)
|
||||
covar beta
|
||||
n nn m mm v dummy p)
|
||||
n m mm v dummy p) ;; nn
|
||||
|
||||
;; Validate and parse arguments.
|
||||
(or data
|
||||
|
|
@ -1687,7 +1696,7 @@
|
|||
(isigsq 1)
|
||||
(xvals (make-vector mm 0))
|
||||
(i 0)
|
||||
j k xval yval sigmasqr wt covj covjk covk betaj lud)
|
||||
j k xval yval sigmasqr wt covj covjk covk betaj) ;; lud
|
||||
(while (<= (setq i (1+ i)) n)
|
||||
|
||||
;; Assign various independent variables for this data point.
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; calcsel2.el --- selection functions for Calc
|
||||
;;; calcsel2.el --- selection functions for Calc -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue