-;;; 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.
(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))
(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
(use-local-map calc-mode-map))
(calcAlg-enter))
-(defvar calc-plain-entry nil)
(defun calcAlg-edit ()
(interactive)
(if (or (not calc-plain-entry)
(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)
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)
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))
-;;; 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.
(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)
(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
(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)))))))))))
-;;; 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.
-;;; 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.
-;;; 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.
-;;; 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.
(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)))
(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
"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)
(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)
(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
(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)
(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))
(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))
(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)
(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]+\\)]")
(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)
;;; 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)
(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)
(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
(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)
-;;; 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.
-;;; 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.
(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)
;; 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)
(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)
(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.
(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.,
(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.,
;;; 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))))
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)
-;;; 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.
-;;; 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.
-;;; 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.
(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)
(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)))
(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)
(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)))
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))
(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
(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)
(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 "
(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))
(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")))
-;;; 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.
(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
(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))
(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)
(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)
-;;; 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.
-;;; 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.
(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 )
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 )
( "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 )
( "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 )
( "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 )
( "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
-;;; 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.
(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)
( 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)
((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)
(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)
"_{" (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)
(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)
(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)
(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)
(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)
(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)
(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
(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)
( 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)
(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)
( 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."
(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 `]'"))
(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
(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)))
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)
(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)
-;;; 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.
(math-calcFunc-to-var (nth 1 oper))
expr)))))
+(defvar calc-mapping-dir nil)
+
(defun calc-reduce (&optional oper accum)
(interactive)
(calc-wrapper
(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)
(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
(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))
(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))
(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)
-;;; 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.
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.")
(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")
(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))
;; 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)
;;;; 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)
(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)))
(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))
(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))
-;;; 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.
-;;; 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.
;; 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)
;; 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)
-;;; 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.
(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)
-;;; 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.
-;;; 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.
(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
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)))
(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))
(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)))
(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))
(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)
(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))
(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)))
(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)))
(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
(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)
-;;; 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.
"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)))
;; 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)
(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)
;; 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 ":= "
(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)))
(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")
(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)
;; 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)
-;;; 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.
(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)
(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)
;; 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)
":\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))
;;; 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)))
(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,
(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)
(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)
,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.
;; 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))
-;;; 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.
-;;; 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.
(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)
(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))
;; (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)))
(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)
(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
-;;; 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.
-;;; 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.
(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))
(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)))
-;;; 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.
;; 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)
-;;; 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.
-;;; 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.
-;;; 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.
;; 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-rgrade (math-grade-vec)
- (if (math-vectorp math-grade-vec)
- (let* ((len (1- (length math-grade-vec))))
+(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 (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)))
(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)
(throw 'syntax "Expected `]'")))
(or (eq math-exp-token 'end)
(math-read-token))
- vals)))
+ vals))))
(defun math-check-for-commas (&optional balancing)
(let ((count 0)
-;;; 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.
(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)
(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)
((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)
(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
-;;; 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.
(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)
(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)
(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))))
;; 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.
(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)))
(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
(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
(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))
(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
(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)
(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))
(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))
(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)
(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))
(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)))
(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)
(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)
(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)
;; 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)))
(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.
(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)))
(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
-;;; 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.
(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"
(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)
"*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
(setq high mid
vhigh vmid)
(setq low mid
- vlow vmid)))
+ ;; vlow vmid
+ )))
(list 'vec mid vmid)))
;;; "mnewt"
(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)
(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))
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)
(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)))
(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)
(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)))
(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))
(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)
(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
(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.
-;;; 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.
projects / emacs.git / commitdiff