1 ;;; calc-misc.el --- miscellaneous functions for Calc
3 ;; Copyright (C) 1990-1993, 2001-2017 Free Software Foundation, Inc.
5 ;; Author: David Gillespie <daveg@synaptics.com>
7 ;; This file is part of GNU Emacs.
9 ;; GNU Emacs is free software: you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation, either version 3 of the License, or
12 ;; (at your option) any later version.
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26 ;; This file is autoloaded from calc.el.
31 ;; Declare functions which are defined elsewhere.
32 (declare-function calc-do-keypad
"calc-keypd" (&optional full-display interactive
))
33 (declare-function calc-inv-hyp-prefix-help
"calc-help" ())
34 (declare-function calc-inverse-prefix-help
"calc-help" ())
35 (declare-function calc-hyperbolic-prefix-help
"calc-help" ())
36 (declare-function calc-option-prefix-help
"calc-help" ())
37 (declare-function calc-explain-why
"calc-stuff" (why &optional more
))
38 (declare-function calc-clear-command-flag
"calc-ext" (f))
39 (declare-function calc-roll-down-with-selections
"calc-sel" (n m
))
40 (declare-function calc-roll-up-with-selections
"calc-sel" (n m
))
41 (declare-function calc-last-args
"calc-undo" (n))
42 (declare-function calc-is-inverse
"calc-ext" ())
43 (declare-function calc-do-prefix-help
"calc-ext" (msgs group key
))
44 (declare-function math-objvecp
"calc-ext" (a))
45 (declare-function math-known-scalarp
"calc-arith" (a &optional assume-scalar
))
46 (declare-function math-vectorp
"calc-ext" (a))
47 (declare-function math-matrixp
"calc-ext" (a))
48 (declare-function math-trunc-special
"calc-arith" (a prec
))
49 (declare-function math-trunc-fancy
"calc-arith" (a))
50 (declare-function math-floor-special
"calc-arith" (a prec
))
51 (declare-function math-floor-fancy
"calc-arith" (a))
52 (declare-function math-square-matrixp
"calc-ext" (a))
53 (declare-function math-matrix-inv-raw
"calc-mtx" (m))
54 (declare-function math-known-matrixp
"calc-arith" (a))
55 (declare-function math-mod-fancy
"calc-arith" (a b
))
56 (declare-function math-pow-of-zero
"calc-arith" (a b
))
57 (declare-function math-pow-zero
"calc-arith" (a b
))
58 (declare-function math-pow-fancy
"calc-arith" (a b
))
59 (declare-function calc-locate-cursor-element
"calc-yank" (pt))
62 (defun calc-dispatch-help (arg)
63 "C-x* is a prefix key sequence; follow it with one of these letters:
65 For turning Calc on and off:
66 C calc. Start the Calculator in a window at the bottom of the screen.
67 O calc-other-window. Start the Calculator but don't select its window.
68 B calc-big-or-small. Control whether to use the full Emacs screen for Calc.
69 Q quick-calc. Use the Calculator in the minibuffer.
70 K calc-keypad. Start the Calculator in keypad mode (X window system only).
71 E calc-embedded. Use the Calculator on a formula in this editing buffer.
72 J calc-embedded-select. Like E, but select appropriate half of => or :=.
73 W calc-embedded-word. Like E, but activate a single word, i.e., a number.
74 Z calc-user-invocation. Invoke Calc in the way you defined with `Z I' cmd.
75 X calc-quit. Turn Calc off.
77 For moving data into and out of Calc:
78 G calc-grab-region. Grab the region defined by mark and point into Calc.
79 R calc-grab-rectangle. Grab the rectangle defined by mark, point into Calc.
80 : calc-grab-sum-down. Grab a rectangle and sum the columns.
81 _ calc-grab-sum-across. Grab a rectangle and sum the rows.
82 Y calc-copy-to-buffer. Copy a value from the stack into the editing buffer.
84 For use with Embedded mode:
85 A calc-embedded-activate. Find and activate all :='s and =>'s in buffer.
86 D calc-embedded-duplicate. Make a copy of this formula and select it.
87 F calc-embedded-new-formula. Insert a new formula at current point.
88 N calc-embedded-next. Advance cursor to next known formula in buffer.
89 P calc-embedded-previous. Advance cursor to previous known formula.
90 U calc-embedded-update-formula. Re-evaluate formula at point.
91 \\=` calc-embedded-edit. Use calc-edit to edit formula at point.
94 I calc-info. Read the Calculator manual in the Emacs Info system.
95 T calc-tutorial. Run the Calculator Tutorial using the Emacs Info system.
96 S calc-summary. Read the Summary from the Calculator manual in Info.
99 L calc-load-everything. Load all parts of the Calculator into memory.
100 M read-kbd-macro. Read a region of keystroke names as a keyboard macro.
101 0 (zero) calc-reset. Reset Calc stack and modes to default state.
103 Press `*' twice (`C-x * *') to turn Calc on or off using the same
104 Calc user interface as before (either C-x * C or C-x * K; initially C-x * C).
108 (if calc-dispatch-help
110 (save-window-excursion
111 (describe-function 'calc-dispatch-help
)
112 (let ((win (get-buffer-window "*Help*")))
117 (message "Calc options: Calc, Keypad, ... %s"
118 "press SPC, DEL to scroll, C-g to cancel")
119 (memq (car (setq key
(calc-read-key t
)))
120 '(? ?\C-h ?\C-? ?\C-v ?\M-v
)))
122 (if (memq (car key
) '(? ?\C-v
))
126 (calc-unread-command (cdr key
))))))
127 (calc-do-dispatch nil
))
128 (let ((calc-dispatch-help t
))
129 (calc-do-dispatch arg
))))
133 (defun calc-big-or-small (arg)
134 "Toggle Calc between full-screen and regular mode."
136 (let ((cwin (get-buffer-window "*Calculator*"))
137 (twin (get-buffer-window "*Calc Trail*"))
138 (kwin (get-buffer-window "*Calc Keypad*")))
142 (and twin
(window-full-width-p twin
))
143 (window-full-height-p cwin
))))
144 (setq calc-full-mode
(if arg
145 (> (prefix-numeric-value arg
) 0)
146 (not calc-full-mode
)))
150 (calc-do-keypad calc-full-mode nil
))
154 (calc nil calc-full-mode nil
))))
155 (message (if calc-full-mode
156 "Now using full screen for Calc"
157 "Now using partial screen for Calc"))))
160 (defun calc-other-window (&optional interactive
)
161 "Invoke the Calculator in another window."
163 (if (memq major-mode
'(calc-mode calc-trail-mode
))
166 (if (memq major-mode
'(calc-mode calc-trail-mode
))
168 (if (get-buffer-window "*Calculator*")
170 (let ((win (selected-window)))
171 (calc nil win interactive
)))))
174 (defun another-calc ()
175 "Create another, independent Calculator buffer."
177 (if (eq major-mode
'calc-mode
)
180 (set-default v
(symbol-value v
)))) calc-local-var-list
))
181 (set-buffer (generate-new-buffer "*Calculator*"))
182 (pop-to-buffer (current-buffer))
187 "Run the Emacs Info system on the Calculator documentation."
189 (select-window (get-largest-window))
193 (defun calc-info-goto-node (node)
194 "Go to a node in the Calculator info documentation."
196 (select-window (get-largest-window))
197 (info (concat "(Calc)" node
)))
200 (defun calc-tutorial ()
201 "Run the Emacs Info system on the Calculator Tutorial."
203 (if (get-buffer-window "*Calculator*")
205 (calc-info-goto-node "Interactive Tutorial")
207 (message "Welcome to the Calc Tutorial!"))
210 (defun calc-info-summary ()
211 "Run the Emacs Info system on the Calculator Summary."
213 (calc-info-goto-node "Summary"))
219 '("Press `h' for complete help; press `?' repeatedly for a summary"
220 "Letter keys: Negate; Precision; Yank; Why; Xtended cmd; Quit"
221 "Letter keys: SHIFT + Undo, reDo; Inverse, Hyperbolic, Option"
222 "Letter keys: SHIFT + sQrt; Sin, Cos, Tan; Exp, Ln, logB"
223 "Letter keys: SHIFT + Floor, Round; Abs, conJ, arG; Pi"
224 "Letter keys: SHIFT + Num-eval; More-recn; eXec-kbd-macro; Keep-args"
225 "Other keys: +, -, *, /, ^, \\ (int div), : (frac div)"
226 "Other keys: & (1/x), | (concat), % (modulo), ! (factorial)"
227 "Other keys: \\=' (alg-entry), = (eval), \\=` (edit); M-RET (last-args)"
228 "Other keys: SPC/RET (enter/dup), LFD (over); < > (scroll horiz)"
229 "Other keys: DEL (drop), M-DEL (drop-above); { } (scroll vert)"
230 "Other keys: TAB (swap/roll-dn), M-TAB (roll-up)"
231 "Other keys: [ , ; ] (vector), ( , ) (complex), ( ; ) (polar)"
232 "Prefix keys: Algebra, Binary/business, Convert, Display"
233 "Prefix keys: Functions, Graphics, Help, J (select)"
234 "Prefix keys: Kombinatorics/statistics, Modes, Store/recall"
235 "Prefix keys: Trail/time, Units/statistics, Vector/matrix"
236 "Prefix keys: Z (user), SHIFT + Z (define)"
237 "Prefix keys: prefix + ? gives further help for that prefix"
238 " Calc by Dave Gillespie, daveg@synaptics.com")))
239 (if calc-full-help-flag
241 (if (or calc-inverse-flag calc-hyperbolic-flag
)
242 (if calc-inverse-flag
243 (if calc-hyperbolic-flag
244 (calc-inv-hyp-prefix-help)
245 (calc-inverse-prefix-help))
246 (calc-hyperbolic-prefix-help))
248 (calc-option-prefix-help)
249 (setq calc-help-phase
250 (if (eq this-command last-command
)
251 (%
(1+ calc-help-phase
) (1+ (length msgs
)))
253 (let ((msg (nth calc-help-phase msgs
)))
254 (message "%s" (if msg
255 (concat (substitute-command-keys msg
) ":"
256 (make-string (- (apply 'max
267 ;;;; Stack and buffer management.
269 ;; The variable calc-last-why-command is set in calc-do-handle-whys
270 ;; and used in calc-why (in calc-stuff.el).
271 (defvar calc-last-why-command
)
274 (defun calc-do-handle-whys ()
275 (setq calc-why
(sort calc-next-why
278 (and (eq (car x
) '*) (not (eq (car y
) '*))))))
280 (if (and calc-why
(or (eq calc-auto-why t
)
281 (and (eq (car (car calc-why
)) '*)
285 (calc-explain-why (car calc-why
)
286 (if (eq calc-auto-why t
)
289 (eq (car (nth 1 calc-why
)) '*))))
290 (setq calc-last-why-command this-command
)
291 (calc-clear-command-flag 'clear-message
))))
294 (defun calc-record-why (&rest stuff
)
295 (if (eq (car stuff
) 'quiet
)
296 (setq stuff
(cdr stuff
))
297 (if (and (symbolp (car stuff
))
299 (or (Math-objectp (nth 1 stuff
))
300 (and (Math-vectorp (nth 1 stuff
))
301 (math-constp (nth 1 stuff
)))
302 (math-infinitep (nth 1 stuff
))))
303 (setq stuff
(cons '* stuff
))
304 (if (and (stringp (car stuff
))
305 (string-match "\\`\\*" (car stuff
)))
306 (setq stuff
(cons '* (cons (substring (car stuff
) 1)
308 (unless (member stuff calc-next-why
)
309 (setq calc-next-why
(cons stuff calc-next-why
)))
312 ;; True if A is a constant or vector of constants. [P x] [Public]
314 (defun math-constp (a)
316 (and (memq (car a
) '(sdev intv mod vec
))
318 (while (and (setq a
(cdr a
))
319 (or (Math-scalarp (car a
)) ; optimization
320 (math-constp (car a
)))))
325 (defun calc-roll-down-stack (n &optional m
)
327 (calc-roll-up-stack (- n
) m
)
328 (if (or (= n
0) (> n
(calc-stack-size))) (setq n
(calc-stack-size)))
332 (if (and calc-any-selections
333 (not calc-use-selections
))
334 (calc-roll-down-with-selections n m
)
335 (calc-pop-push-list n
336 (append (calc-top-list m
1)
337 (calc-top-list (- n m
) (1+ m
))))))))
340 (defun calc-roll-up-stack (n &optional m
)
342 (calc-roll-down-stack (- n
) m
)
343 (if (or (= n
0) (> n
(calc-stack-size))) (setq n
(calc-stack-size)))
347 (if (and calc-any-selections
348 (not calc-use-selections
))
349 (calc-roll-up-with-selections n m
)
350 (calc-pop-push-list n
351 (append (calc-top-list (- n m
) 1)
352 (calc-top-list m
(- n m -
1))))))))
356 (defun calc-do-refresh ()
357 (if calc-hyperbolic-flag
359 (setq calc-display-dirty t
)
366 (defun calc-record-list (vals &optional prefix
)
368 (or (eq (car vals
) 'top-of-stack
)
370 (calc-record (car vals
) prefix
)
371 (setq prefix
"...")))
372 (setq vals
(cdr vals
))))
376 (defun calc-last-args-stub (arg)
379 (calc-last-args arg
))
383 (defun calc-power (arg)
386 (if (and (featurep 'calc-ext
)
388 (calc-binary-op "root" 'calcFunc-nroot arg nil nil
)
389 (calc-binary-op "^" 'calcFunc-pow arg nil nil
'^
))))
392 (defun calc-mod (arg)
395 (calc-binary-op "%" 'calcFunc-mod arg nil nil
'%
)))
398 (defun calc-inv (arg)
401 (calc-unary-op "inv" 'calcFunc-inv arg
)))
404 (defun calc-percent ()
407 (calc-pop-push-record-list
408 1 "%" (list (list 'calcFunc-percent
(calc-top-n 1))))))
415 (calc-enter (- (prefix-numeric-value n
)))
420 (defun calc-pop-above (n)
423 (calc-pop (- (prefix-numeric-value n
)))
427 (defun calc-roll-down (n)
430 (let ((nn (prefix-numeric-value n
)))
432 (calc-roll-down-stack 2))
434 (calc-roll-down-stack nn
))
436 (calc-pop-push-list (calc-stack-size)
438 (calc-top-list (calc-stack-size)))))
440 (calc-roll-down-stack (calc-stack-size) (- nn
)))))))
443 (defun calc-roll-up (n)
446 (let ((nn (prefix-numeric-value n
)))
448 (calc-roll-up-stack 3))
450 (calc-roll-up-stack nn
))
452 (calc-pop-push-list (calc-stack-size)
454 (calc-top-list (calc-stack-size)))))
456 (calc-roll-up-stack (calc-stack-size) (- nn
)))))))
459 (defun calc-transpose-lines (&optional arg
)
460 "Transpose previous line and current line.
461 With argument ARG, move previous line past ARG lines.
462 With argument 0, switch line point is in with line mark is in."
464 (setq arg
(or arg
1))
465 (let (bot-line mid-line end-line
466 old-top-list new-top-list
468 prev-mid-cell post-mid-cell post-bot-cell
)
470 (when (eq major-mode
'calc-mode
)
472 ;; exchange point and mark
474 (setq bot-line
(calc-locate-cursor-element (point))
477 (setq mid-line
(calc-locate-cursor-element mid-line
)
478 end-line
(1+ mid-line
))
479 (error "No mark set"))
480 (if (< bot-line mid-line
)
481 (let ((temp mid-line
))
482 (setq mid-line bot-line
484 ;; move bot-line to mid-line that is above bot-line on stack (that is
485 ;; to say mid-line displayed below bot-line in *Calculator* buffer)
487 (setq bot-line
(1+ (calc-locate-cursor-element (point)))
488 mid-line
(- bot-line arg
)
490 ;; move bot-line to mid-line that is above bot-line on stack (that is
491 ;; to say mid-line displayed below bot-line in *Calculator* buffer)
493 (setq mid-line
(1+ (calc-locate-cursor-element (point)))
494 bot-line
(- mid-line arg
)
496 (calc-check-stack bot-line
)
498 (error "Can't transpose beyond top"))
499 (setq old-top-list
(nreverse (calc-top-list bot-line
)))
500 ;; example: (arg = 2)
502 ;; 1 <-- top of stack (bottom of *Calculator* buffer)
504 ;; 3 <-- mid-line = 3
506 ;; 5 <-- bot-line = 5
507 (dotimes (i mid-line
)
508 (setq mid-cell old-top-list
509 old-top-list
(cdr old-top-list
))
510 (setcdr mid-cell new-top-list
)
511 (setq new-top-list mid-cell
))
512 ;; example follow-up:
520 (setq prev-mid-cell old-top-list
)
521 (dotimes (i (- bot-line mid-line
))
522 (setq bot-cell old-top-list
523 old-top-list
(cdr old-top-list
))
524 (setcdr bot-cell new-top-list
)
525 (setq new-top-list bot-cell
))
526 (setq post-mid-cell
(cdr mid-cell
)
527 post-bot-cell
(cdr bot-cell
))
528 ;; example follow-up:
531 ;; 4 <-- prev-mid-cell & post-bot-cell
533 ;; 2 <-- post-mid-cell
536 ((= 0 arg
); swap bot and mid
537 (setcdr mid-cell post-bot-cell
)
538 (setcdr bot-cell post-mid-cell
)
539 (setcdr prev-mid-cell bot-cell
)
540 ;; example follow-up:
542 ;; 4 <-- post-bot-cell & prev-mid-cell
544 ;; 2 <-- post-mid-cell
546 (setq new-top-list mid-cell
))
547 ((< 0 arg
) ; move bot just after mid
548 (setcdr mid-cell bot-cell
)
549 (setcdr bot-cell post-mid-cell
)
550 ;; example follow-up:
552 ;; 4 <-- post-bot-cell
555 ;; 2 <-- post-mid-cell
557 (setq new-top-list post-bot-cell
))
558 ((> 0 arg
) ; move mid just before bot
559 (setcdr mid-cell bot-cell
)
560 (setcdr prev-mid-cell post-mid-cell
)
561 ;; example follow-up:
565 ;; 4 <-- prev-mid-cell
566 ;; 2 <-- post-mid-cell
568 (setq new-top-list mid-cell
)))
569 (calc-pop-push-list bot-line new-top-list
)))
570 (calc-cursor-stack-index (1- end-line
))))
577 (defun calc-num-prefix-name (n)
578 (cond ((eq n
'-
) "- ")
579 ((equal n
'(4)) "C-u ")
580 ((consp n
) (format "%d " (car n
)))
581 ((integerp n
) (format "%d " n
))
585 (defun calc-missing-key (n)
586 "This is a placeholder for a command which needs to be loaded from calc-ext.
587 When this key is used, calc-ext (the Calculator extensions module) will be
588 loaded and the keystroke automatically re-typed."
591 (if (keymapp (key-binding (char-to-string last-command-event
)))
592 (message "%s%c-" (calc-num-prefix-name n
) last-command-event
))
593 (calc-unread-command)
597 (defun calc-shift-Y-prefix-help ()
600 (calc-do-prefix-help calc-Y-help-msgs
"other" ?Y
))
606 (defun calcDigit-letter ()
608 (if (calc-minibuffer-contains "[-+]?\\(1[1-9]\\|[2-9][0-9]\\)#.*")
610 (setq last-command-event
(upcase last-command-event
))
612 (calcDigit-nondigit)))
615 ;; A Lisp version of temp_minibuffer_message from minibuf.c.
617 (defun calc-temp-minibuffer-message (m)
618 (let ((savemax (point-max)))
620 (goto-char (point-max))
626 (identity 1) ; This forces a call to maybe_quit in bytecode.c.
629 (delete-region savemax
(point-max))
630 (or okay
(abort-recursive-edit)))))))
633 (put 'math-with-extra-prec
'lisp-indent-hook
1)
636 ;; Concatenate two vectors, or a vector and an object. [V O O] [Public]
638 (defun math-concat (v1 v2
)
642 (if (and (or (math-objvecp v1
) (math-known-scalarp v1
))
643 (or (math-objvecp v2
) (math-known-scalarp v2
)))
644 (append (if (and (math-vectorp v1
)
645 (or (math-matrixp v1
)
646 (not (math-matrixp v2
))))
649 (if (and (math-vectorp v2
)
650 (or (math-matrixp v2
)
651 (not (math-matrixp v1
))))
657 ;; True if A is zero. Works for un-normalized values. [P n] [Public]
659 (defun math-zerop (a)
661 (cond ((memq (car a
) '(bigpos bigneg
))
662 (while (eq (car (setq a
(cdr a
))) 0))
664 ((memq (car a
) '(frac float polar mod
))
665 (math-zerop (nth 1 a
)))
667 (and (math-zerop (nth 1 a
)) (math-zerop (nth 2 a
))))
669 (and (math-zerop (nth 1 a
))
670 (math-zerop (nth 2 a
))
671 (math-zerop (nth 3 a
)))))
675 ;; True if A is real and negative. [P n] [Public]
680 (cond ((eq (car a
) 'bigpos
) nil
)
681 ((eq (car a
) 'bigneg
) (cdr a
))
682 ((memq (car a
) '(float frac
))
683 (Math-integer-negp (nth 1 a
)))
685 (if (math-zerop (nth 1 a
))
686 (if (math-zerop (nth 2 a
))
687 (math-negp (nth 3 a
))
688 (math-negp (nth 2 a
)))
689 (math-negp (nth 1 a
))))
691 (math-negp (nth 1 a
)))
693 (or (math-negp (nth 3 a
))
694 (and (math-zerop (nth 3 a
))
695 (memq (nth 1 a
) '(0 2)))))
696 ((equal a
'(neg (var inf var-inf
))) t
))
699 ;; True if A is a negative number or an expression the starts with '-'.
701 (defun math-looks-negp (a) ; [P x] [Public]
703 (eq (car-safe a
) 'neg
)
704 (and (memq (car-safe a
) '(* /))
705 (or (math-looks-negp (nth 1 a
))
706 (math-looks-negp (nth 2 a
))))
707 (and (eq (car-safe a
) '-
)
708 (math-looks-negp (nth 1 a
)))))
711 ;; True if A is real and positive. [P n] [Public]
715 (cond ((eq (car a
) 'bigpos
) (cdr a
))
716 ((eq (car a
) 'bigneg
) nil
)
717 ((memq (car a
) '(float frac
))
718 (Math-integer-posp (nth 1 a
)))
720 (if (math-zerop (nth 1 a
))
721 (if (math-zerop (nth 2 a
))
722 (math-posp (nth 3 a
))
723 (math-posp (nth 2 a
)))
724 (math-posp (nth 1 a
))))
726 (math-posp (nth 1 a
)))
728 (not (math-zerop (nth 1 a
))))
730 (or (math-posp (nth 2 a
))
731 (and (math-zerop (nth 2 a
))
732 (memq (nth 1 a
) '(0 1)))))
733 ((equal a
'(var inf var-inf
)) t
))
737 (defalias 'math-fixnump
'integerp
)
739 (defalias 'math-fixnatnump
'natnump
)
742 ;; True if A is an even integer. [P R R] [Public]
744 (defun math-evenp (a)
746 (and (memq (car a
) '(bigpos bigneg
))
747 (= (%
(nth 1 a
) 2) 0))
750 ;; Compute A / 2, for small or big integer A. [I i]
751 ;; If A is negative, type of truncation is undefined.
756 (math-normalize (cons (car a
) (math-div2-bignum (cdr a
))))
761 (defun math-div2-bignum (a) ; [l l]
763 (cons (+ (/ (car a
) 2) (* (%
(nth 1 a
) 2) (/ math-bignum-digit-size
2)))
764 (math-div2-bignum (cdr a
)))
765 (list (/ (car a
) 2))))
768 ;; Reject an argument to a calculator function. [Public]
770 (defun math-reject-arg (&optional a p option
)
772 (calc-record-why option p a
)
774 (calc-record-why p a
)))
775 (signal 'wrong-type-argument
(and a
(if p
(list p a
) (list a
)))))
778 ;; Coerce A to be an integer (by truncation toward zero). [I N] [Public]
780 ;; The variable math-trunc-prec is local to math-trunc, but used by
781 ;; math-trunc-fancy in calc-arith.el, which is called by math-trunc.
784 (defun math-trunc (a &optional math-trunc-prec
)
785 (cond (math-trunc-prec
787 (math-trunc-special a math-trunc-prec
))
788 ((Math-integerp a
) a
)
790 (math-neg (math-trunc (math-neg a
))))
792 (math-scale-int (nth 1 a
) (nth 2 a
)))
793 (t (require 'calc-ext
)
794 (math-trunc-fancy a
))))
796 (defalias 'calcFunc-trunc
'math-trunc
)
798 ;; Coerce A to be an integer (by truncation toward minus infinity). [I N]
800 ;; The variable math-floor-prec is local to math-floor, but used by
801 ;; math-floor-fancy in calc-arith.el, which is called by math-floor.
804 (defun math-floor (a &optional math-floor-prec
) ; [Public]
805 (cond (math-floor-prec
807 (math-floor-special a math-floor-prec
))
808 ((Math-integerp a
) a
)
809 ((Math-messy-integerp a
) (math-trunc a
))
812 (math-add (math-trunc a
) -
1)
814 (t (require 'calc-ext
)
815 (math-floor-fancy a
))))
817 (defalias 'calcFunc-floor
'math-floor
)
821 (defun math-imod (a b
) ; [I I I] [Public]
822 (if (and (not (consp a
)) (not (consp b
)))
824 (math-reject-arg a
"*Division by zero")
826 (cdr (math-idivmod a b
))))
830 (defun calcFunc-inv (m)
834 (if (math-square-matrixp m
)
835 (or (math-with-extra-prec 2 (math-matrix-inv-raw m
))
836 (math-reject-arg m
"*Singular matrix"))
837 (math-reject-arg m
'square-matrixp
)))
839 (require 'calc-arith
)
840 (math-known-matrixp m
))
845 (defun math-do-working (msg arg
)
846 (or executing-kbd-macro
848 (calc-set-command-flag 'clear-message
)
849 (if math-working-step
850 (if math-working-step-2
851 (setq msg
(format "[%d/%d] %s"
852 math-working-step math-working-step-2 msg
))
853 (setq msg
(format "[%d] %s" math-working-step msg
))))
854 (message "Working... %s = %s" msg
855 (math-showing-full-precision (math-format-number arg
))))))
858 ;; Compute A modulo B, defined in terms of truncation toward minus infinity.
860 (defun math-mod (a b
) ; [R R R] [Public]
861 (cond ((and (Math-zerop a
) (not (eq (car-safe a
) 'mod
))) a
)
863 (math-reject-arg a
"*Division by zero"))
864 ((and (Math-natnump a
) (Math-natnump b
))
866 ((and (Math-anglep a
) (Math-anglep b
))
867 (math-sub a
(math-mul (math-floor (math-div a b
)) b
)))
868 (t (require 'calc-ext
)
869 (math-mod-fancy a b
))))
873 ;;; General exponentiation.
876 (defun math-pow (a b
) ; [O O N] [Public]
877 (cond ((equal b
'(var nan var-nan
))
880 (if (and (Math-scalarp b
) (Math-posp b
))
881 (if (math-floatp b
) (math-float a
) a
)
883 (math-pow-of-zero a b
)))
884 ((or (eq a
1) (eq b
1)) a
)
885 ((or (equal a
'(float 1 0)) (equal b
'(float 1 0))) a
)
888 (if (or (math-floatp a
) (math-floatp b
))
891 (math-pow-zero a b
)))
892 ((and (Math-integerp b
) (or (Math-numberp a
) (Math-vectorp a
)))
893 (if (and (equal a
'(float 1 1)) (integerp b
))
894 (math-make-float 1 b
)
895 (math-with-extra-prec 2
899 (math-pow-fancy a b
))))
902 (defun math-ipow (a n
) ; [O O I] [Public]
903 (cond ((Math-integer-negp n
)
904 (math-ipow (math-div 1 a
) (Math-integer-neg n
)))
906 (if (and (Math-ratp a
) (> n
20))
907 (math-iipow-show a n
)
910 (math-ipow (math-mul a a
) (math-div2 n
)))
912 (math-mul a
(math-ipow (math-mul a a
)
913 (math-div2 (math-add n -
1)))))))
915 (defun math-iipow (a n
) ; [O O S]
918 ((= (% n
2) 0) (math-iipow (math-mul a a
) (/ n
2)))
919 (t (math-mul a
(math-iipow (math-mul a a
) (/ n
2))))))
921 (defun math-iipow-show (a n
) ; [O O S]
922 (math-working "pow" a
)
926 ((= (% n
2) 0) (math-iipow-show (math-mul a a
) (/ n
2)))
927 (t (math-mul a
(math-iipow-show (math-mul a a
) (/ n
2)))))))
928 (math-working "pow" val
)
933 (defun math-read-radix-digit (dig) ; [D S; Z S]
946 (defun report-calc-bug ()
947 "Report a bug in Calc, the GNU Emacs calculator.
948 Prompts for bug subject. Leaves you in a mail buffer."
950 (let ((reporter-prompt-for-summary-p t
))
951 (reporter-submit-bug-report calc-bug-address
"Calc"
953 "Please describe exactly what actions triggered the bug and the
954 precise symptoms of the bug. If possible, include a backtrace by
955 doing `\\[toggle-debug-on-error]', then reproducing the bug.
958 (defalias 'calc-report-bug
'report-calc-bug
)
963 ;; generated-autoload-file: "calc-loaddefs.el"
966 ;;; calc-misc.el ends here