calc-misc.el 29.4 KB
Newer Older
Juanma Barranquero's avatar
Juanma Barranquero committed
1
;;; calc-misc.el --- miscellaneous functions for Calc
2

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
4 5

;; Author: David Gillespie <daveg@synaptics.com>
Jay Belanger's avatar
Jay Belanger committed
6
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
Eli Zaretskii's avatar
Eli Zaretskii committed
7 8 9

;; This file is part of GNU Emacs.

10
;; GNU Emacs is free software: you can redistribute it and/or modify
11
;; it under the terms of the GNU General Public License as published by
12 13
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
14

Eli Zaretskii's avatar
Eli Zaretskii committed
15
;; GNU Emacs is distributed in the hope that it will be useful,
16 17 18 19 20
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
21
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
Eli Zaretskii's avatar
Eli Zaretskii committed
22

23
;;; Commentary:
Eli Zaretskii's avatar
Eli Zaretskii committed
24

25
;;; Code:
Eli Zaretskii's avatar
Eli Zaretskii committed
26 27 28

;; This file is autoloaded from calc.el.

Jay Belanger's avatar
Jay Belanger committed
29
(require 'calc)
Eli Zaretskii's avatar
Eli Zaretskii committed
30 31
(require 'calc-macs)

32 33 34 35 36
;; Declare functions which are defined elsewhere.
(declare-function calc-do-keypad "calc-keypd" (&optional full-display interactive))
(declare-function calc-inv-hyp-prefix-help "calc-help" ())
(declare-function calc-inverse-prefix-help "calc-help" ())
(declare-function calc-hyperbolic-prefix-help "calc-help" ())
37
(declare-function calc-option-prefix-help "calc-help" ())
38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59
(declare-function calc-explain-why "calc-stuff" (why &optional more))
(declare-function calc-clear-command-flag "calc-ext" (f))
(declare-function calc-roll-down-with-selections "calc-sel" (n m))
(declare-function calc-roll-up-with-selections "calc-sel" (n m))
(declare-function calc-last-args "calc-undo" (n))
(declare-function calc-is-inverse "calc-ext" ())
(declare-function calc-do-prefix-help "calc-ext" (msgs group key))
(declare-function math-objvecp "calc-ext" (a))
(declare-function math-known-scalarp "calc-arith" (a &optional assume-scalar))
(declare-function math-vectorp "calc-ext" (a))
(declare-function math-matrixp "calc-ext" (a))
(declare-function math-trunc-special "calc-arith" (a prec))
(declare-function math-trunc-fancy "calc-arith" (a))
(declare-function math-floor-special "calc-arith" (a prec))
(declare-function math-floor-fancy "calc-arith" (a))
(declare-function math-square-matrixp "calc-ext" (a))
(declare-function math-matrix-inv-raw "calc-mtx" (m))
(declare-function math-known-matrixp "calc-arith" (a))
(declare-function math-mod-fancy "calc-arith" (a b))
(declare-function math-pow-of-zero "calc-arith" (a b))
(declare-function math-pow-zero "calc-arith" (a b))
(declare-function math-pow-fancy "calc-arith" (a b))
60
(declare-function calc-locate-cursor-element "calc-yank" (pt))
61

62
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
63
(defun calc-dispatch-help (arg)
64
  "C-x* is a prefix key sequence; follow it with one of these letters:
Eli Zaretskii's avatar
Eli Zaretskii committed
65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91

For turning Calc on and off:
  C  calc.  Start the Calculator in a window at the bottom of the screen.
  O  calc-other-window.  Start the Calculator but don't select its window.
  B  calc-big-or-small.  Control whether to use the full Emacs screen for Calc.
  Q  quick-calc.  Use the Calculator in the minibuffer.
  K  calc-keypad.  Start the Calculator in keypad mode (X window system only).
  E  calc-embedded.  Use the Calculator on a formula in this editing buffer.
  J  calc-embedded-select.  Like E, but select appropriate half of => or :=.
  W  calc-embedded-word.  Like E, but activate a single word, i.e., a number.
  Z  calc-user-invocation.  Invoke Calc in the way you defined with `Z I' cmd.
  X  calc-quit.  Turn Calc off.

For moving data into and out of Calc:
  G  calc-grab-region.  Grab the region defined by mark and point into Calc.
  R  calc-grab-rectangle.  Grab the rectangle defined by mark, point into Calc.
  :  calc-grab-sum-down.  Grab a rectangle and sum the columns.
  _  calc-grab-sum-across.  Grab a rectangle and sum the rows.
  Y  calc-copy-to-buffer.  Copy a value from the stack into the editing buffer.

For use with Embedded mode:
  A  calc-embedded-activate.  Find and activate all :='s and =>'s in buffer.
  D  calc-embedded-duplicate.  Make a copy of this formula and select it.
  F  calc-embedded-new-formula.  Insert a new formula at current point.
  N  calc-embedded-next.  Advance cursor to next known formula in buffer.
  P  calc-embedded-previous.  Advance cursor to previous known formula.
  U  calc-embedded-update-formula.  Re-evaluate formula at point.
92
  \\=`  calc-embedded-edit.  Use calc-edit to edit formula at point.
Eli Zaretskii's avatar
Eli Zaretskii committed
93 94 95 96 97 98 99 100 101 102 103

Documentation:
  I  calc-info.  Read the Calculator manual in the Emacs Info system.
  T  calc-tutorial.  Run the Calculator Tutorial using the Emacs Info system.
  S  calc-summary.  Read the Summary from the Calculator manual in Info.

Miscellaneous:
  L  calc-load-everything.  Load all parts of the Calculator into memory.
  M  read-kbd-macro.  Read a region of keystroke names as a keyboard macro.
  0  (zero) calc-reset.  Reset Calc stack and modes to default state.

104 105 106
Press `*' twice (`C-x * *') to turn Calc on or off using the same
Calc user interface as before (either C-x * C or C-x * K; initially C-x * C).
"
Eli Zaretskii's avatar
Eli Zaretskii committed
107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129
  (interactive "P")
  (calc-check-defines)
  (if calc-dispatch-help
      (progn
	(save-window-excursion
	  (describe-function 'calc-dispatch-help)
	  (let ((win (get-buffer-window "*Help*")))
	    (if win
		(let (key)
		  (select-window win)
		  (while (progn
			   (message "Calc options: Calc, Keypad, ...  %s"
				    "press SPC, DEL to scroll, C-g to cancel")
			   (memq (car (setq key (calc-read-key t)))
				 '(?  ?\C-h ?\C-? ?\C-v ?\M-v)))
		    (condition-case err
			(if (memq (car key) '(?  ?\C-v))
			    (scroll-up)
			  (scroll-down))
		      (error (beep))))
		      (calc-unread-command (cdr key))))))
	(calc-do-dispatch nil))
    (let ((calc-dispatch-help t))
130
      (calc-do-dispatch arg))))
Eli Zaretskii's avatar
Eli Zaretskii committed
131 132


133
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
134 135 136 137 138 139 140 141 142
(defun calc-big-or-small (arg)
  "Toggle Calc between full-screen and regular mode."
  (interactive "P")
  (let ((cwin (get-buffer-window "*Calculator*"))
	(twin (get-buffer-window "*Calc Trail*"))
	(kwin (get-buffer-window "*Calc Keypad*")))
    (if cwin
	(setq calc-full-mode
	      (if kwin
Glenn Morris's avatar
Glenn Morris committed
143 144
		  (and twin (window-full-width-p twin))
		(window-full-height-p cwin))))
Eli Zaretskii's avatar
Eli Zaretskii committed
145 146 147 148 149 150 151 152 153 154 155 156
    (setq calc-full-mode (if arg
			     (> (prefix-numeric-value arg) 0)
			   (not calc-full-mode)))
    (if kwin
	(progn
	  (calc-quit)
	  (calc-do-keypad calc-full-mode nil))
      (if cwin
	  (progn
	    (calc-quit)
	    (calc nil calc-full-mode nil))))
    (message (if calc-full-mode
157 158
		 "Now using full screen for Calc"
	       "Now using partial screen for Calc"))))
Eli Zaretskii's avatar
Eli Zaretskii committed
159

160
;;;###autoload
161
(defun calc-other-window (&optional interactive)
Eli Zaretskii's avatar
Eli Zaretskii committed
162
  "Invoke the Calculator in another window."
163
  (interactive "p")
Eli Zaretskii's avatar
Eli Zaretskii committed
164 165 166 167 168 169 170 171
  (if (memq major-mode '(calc-mode calc-trail-mode))
      (progn
	(other-window 1)
	(if (memq major-mode '(calc-mode calc-trail-mode))
	    (other-window 1)))
    (if (get-buffer-window "*Calculator*")
	(calc-quit)
      (let ((win (selected-window)))
172
	(calc nil win interactive)))))
Eli Zaretskii's avatar
Eli Zaretskii committed
173

174
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
175 176 177 178
(defun another-calc ()
  "Create another, independent Calculator buffer."
  (interactive)
  (if (eq major-mode 'calc-mode)
179 180 181
      (mapc (function
	     (lambda (v)
	      (set-default v (symbol-value v)))) calc-local-var-list))
Eli Zaretskii's avatar
Eli Zaretskii committed
182 183
  (set-buffer (generate-new-buffer "*Calculator*"))
  (pop-to-buffer (current-buffer))
184
  (calc-mode))
Eli Zaretskii's avatar
Eli Zaretskii committed
185

186
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
187 188 189 190
(defun calc-info ()
  "Run the Emacs Info system on the Calculator documentation."
  (interactive)
  (select-window (get-largest-window))
191
  (info "Calc"))
Eli Zaretskii's avatar
Eli Zaretskii committed
192

193
;;;###autoload
194 195 196 197
(defun calc-info-goto-node (node)
  "Go to a node in the Calculator info documentation."
  (interactive)
  (select-window (get-largest-window))
198
  (info (concat "(Calc)" node)))
199

200
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
201 202 203 204 205
(defun calc-tutorial ()
  "Run the Emacs Info system on the Calculator Tutorial."
  (interactive)
  (if (get-buffer-window "*Calculator*")
      (calc-quit))
206
  (calc-info-goto-node "Interactive Tutorial")
Eli Zaretskii's avatar
Eli Zaretskii committed
207
  (calc-other-window)
208
  (message "Welcome to the Calc Tutorial!"))
Eli Zaretskii's avatar
Eli Zaretskii committed
209

210
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
211 212 213
(defun calc-info-summary ()
  "Run the Emacs Info system on the Calculator Summary."
  (interactive)
214
  (calc-info-goto-node "Summary"))
Eli Zaretskii's avatar
Eli Zaretskii committed
215

216
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
217 218
(defun calc-help ()
  (interactive)
219
  (let ((msgs
Eli Zaretskii's avatar
Eli Zaretskii committed
220 221
	 '("Press `h' for complete help; press `?' repeatedly for a summary"
	   "Letter keys: Negate; Precision; Yank; Why; Xtended cmd; Quit"
222
	   "Letter keys: SHIFT + Undo, reDo; Inverse, Hyperbolic, Option"
Eli Zaretskii's avatar
Eli Zaretskii committed
223 224
	   "Letter keys: SHIFT + sQrt; Sin, Cos, Tan; Exp, Ln, logB"
	   "Letter keys: SHIFT + Floor, Round; Abs, conJ, arG; Pi"
225
	   "Letter keys: SHIFT + Num-eval; More-recn; eXec-kbd-macro; Keep-args"
Eli Zaretskii's avatar
Eli Zaretskii committed
226 227
	   "Other keys: +, -, *, /, ^, \\ (int div), : (frac div)"
	   "Other keys: & (1/x), | (concat), % (modulo), ! (factorial)"
228
	   "Other keys: ' (alg-entry), = (eval), \\=` (edit); M-RET (last-args)"
Eli Zaretskii's avatar
Eli Zaretskii committed
229 230 231 232 233 234 235 236 237
	   "Other keys: SPC/RET (enter/dup), LFD (over); < > (scroll horiz)"
	   "Other keys: DEL (drop), M-DEL (drop-above); { } (scroll vert)"
	   "Other keys: TAB (swap/roll-dn), M-TAB (roll-up)"
	   "Other keys: [ , ; ] (vector), ( , ) (complex), ( ; ) (polar)"
	   "Prefix keys: Algebra, Binary/business, Convert, Display"
	   "Prefix keys: Functions, Graphics, Help, J (select)"
	   "Prefix keys: Kombinatorics/statistics, Modes, Store/recall"
	   "Prefix keys: Trail/time, Units/statistics, Vector/matrix"
	   "Prefix keys: Z (user), SHIFT + Z (define)"
238 239
	   "Prefix keys: prefix + ? gives further help for that prefix"
           "  Calc by Dave Gillespie, daveg@synaptics.com")))
Eli Zaretskii's avatar
Eli Zaretskii committed
240 241 242 243 244 245 246 247
    (if calc-full-help-flag
	msgs
      (if (or calc-inverse-flag calc-hyperbolic-flag)
	  (if calc-inverse-flag
	      (if calc-hyperbolic-flag
		  (calc-inv-hyp-prefix-help)
		(calc-inverse-prefix-help))
	    (calc-hyperbolic-prefix-help))
248 249 250 251 252 253 254 255 256 257 258 259 260 261 262
        (if calc-option-flag
            (calc-option-prefix-help)
          (setq calc-help-phase
                (if (eq this-command last-command)
                    (% (1+ calc-help-phase) (1+ (length msgs)))
                  0))
          (let ((msg (nth calc-help-phase msgs)))
            (message "%s" (if msg
                              (concat msg ":"
                                      (make-string (- (apply 'max
                                                             (mapcar 'length
                                                                     msgs))
                                                      (length msg)) 32)
                                      "  [?=MORE]")
                            ""))))))))
Paul Eggert's avatar
Paul Eggert committed
263

Eli Zaretskii's avatar
Eli Zaretskii committed
264 265 266 267 268



;;;; Stack and buffer management.

Paul Eggert's avatar
Paul Eggert committed
269
;; The variable calc-last-why-command is set in calc-do-handle-whys
270 271
;; and used in calc-why (in calc-stuff.el).
(defvar calc-last-why-command)
Eli Zaretskii's avatar
Eli Zaretskii committed
272

273
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
274 275 276 277 278 279 280 281 282 283
(defun calc-do-handle-whys ()
  (setq calc-why (sort calc-next-why
		       (function
			(lambda (x y)
			  (and (eq (car x) '*) (not (eq (car y) '*))))))
	calc-next-why nil)
  (if (and calc-why (or (eq calc-auto-why t)
			(and (eq (car (car calc-why)) '*)
			     calc-auto-why)))
      (progn
284
	(require 'calc-ext)
Eli Zaretskii's avatar
Eli Zaretskii committed
285 286 287 288 289 290
	(calc-explain-why (car calc-why)
			  (if (eq calc-auto-why t)
			      (cdr calc-why)
			    (if calc-auto-why
				(eq (car (nth 1 calc-why)) '*))))
	(setq calc-last-why-command this-command)
291
	(calc-clear-command-flag 'clear-message))))
Eli Zaretskii's avatar
Eli Zaretskii committed
292

293
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
294 295 296 297 298 299 300 301 302 303 304 305 306 307
(defun calc-record-why (&rest stuff)
  (if (eq (car stuff) 'quiet)
      (setq stuff (cdr stuff))
    (if (and (symbolp (car stuff))
	     (cdr stuff)
	     (or (Math-objectp (nth 1 stuff))
		 (and (Math-vectorp (nth 1 stuff))
		      (math-constp (nth 1 stuff)))
		 (math-infinitep (nth 1 stuff))))
	(setq stuff (cons '* stuff))
      (if (and (stringp (car stuff))
	       (string-match "\\`\\*" (car stuff)))
	  (setq stuff (cons '* (cons (substring (car stuff) 1)
				     (cdr stuff)))))))
308 309
  (unless (member stuff calc-next-why)
    (setq calc-next-why (cons stuff calc-next-why)))
310
  nil)
Eli Zaretskii's avatar
Eli Zaretskii committed
311

312 313
;; True if A is a constant or vector of constants.  [P x] [Public]
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
314 315 316 317 318 319 320
(defun math-constp (a)
  (or (Math-scalarp a)
      (and (memq (car a) '(sdev intv mod vec))
	   (progn
	     (while (and (setq a (cdr a))
			 (or (Math-scalarp (car a))  ; optimization
			     (math-constp (car a)))))
321
	     (null a)))))
Eli Zaretskii's avatar
Eli Zaretskii committed
322 323


324
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
325 326 327 328 329 330 331 332 333 334 335 336
(defun calc-roll-down-stack (n &optional m)
  (if (< n 0)
      (calc-roll-up-stack (- n) m)
    (if (or (= n 0) (> n (calc-stack-size))) (setq n (calc-stack-size)))
    (or m (setq m 1))
    (and (> n 1)
	 (< m n)
	 (if (and calc-any-selections
		  (not calc-use-selections))
	     (calc-roll-down-with-selections n m)
	   (calc-pop-push-list n
			       (append (calc-top-list m 1)
337
				       (calc-top-list (- n m) (1+ m))))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
338

339
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
340 341 342 343 344 345 346 347 348 349 350 351
(defun calc-roll-up-stack (n &optional m)
  (if (< n 0)
      (calc-roll-down-stack (- n) m)
    (if (or (= n 0) (> n (calc-stack-size))) (setq n (calc-stack-size)))
    (or m (setq m 1))
    (and (> n 1)
	 (< m n)
	 (if (and calc-any-selections
		  (not calc-use-selections))
	     (calc-roll-up-with-selections n m)
	   (calc-pop-push-list n
			       (append (calc-top-list (- n m) 1)
352
				       (calc-top-list m (- n m -1))))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
353 354


355
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
356 357 358 359 360 361
(defun calc-do-refresh ()
  (if calc-hyperbolic-flag
      (progn
	(setq calc-display-dirty t)
	nil)
    (calc-refresh)
362
    t))
Eli Zaretskii's avatar
Eli Zaretskii committed
363 364


365
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
366 367 368 369 370 371
(defun calc-record-list (vals &optional prefix)
  (while vals
    (or (eq (car vals) 'top-of-stack)
	(progn
	  (calc-record (car vals) prefix)
	  (setq prefix "...")))
372
    (setq vals (cdr vals))))
Eli Zaretskii's avatar
Eli Zaretskii committed
373 374


375
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
376 377
(defun calc-last-args-stub (arg)
  (interactive "p")
378
  (require 'calc-ext)
379
  (calc-last-args arg))
Eli Zaretskii's avatar
Eli Zaretskii committed
380 381


382
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
383 384 385
(defun calc-power (arg)
  (interactive "P")
  (calc-slow-wrapper
386
   (if (and (featurep 'calc-ext)
Eli Zaretskii's avatar
Eli Zaretskii committed
387 388
	    (calc-is-inverse))
       (calc-binary-op "root" 'calcFunc-nroot arg nil nil)
389
     (calc-binary-op "^" 'calcFunc-pow arg nil nil '^))))
Eli Zaretskii's avatar
Eli Zaretskii committed
390

391
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
392 393 394
(defun calc-mod (arg)
  (interactive "P")
  (calc-slow-wrapper
395
   (calc-binary-op "%" 'calcFunc-mod arg nil nil '%)))
Eli Zaretskii's avatar
Eli Zaretskii committed
396

397
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
398 399 400
(defun calc-inv (arg)
  (interactive "P")
  (calc-slow-wrapper
401
   (calc-unary-op "inv" 'calcFunc-inv arg)))
Eli Zaretskii's avatar
Eli Zaretskii committed
402

403
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
404 405 406 407
(defun calc-percent ()
  (interactive)
  (calc-slow-wrapper
   (calc-pop-push-record-list
408
    1 "%" (list (list 'calcFunc-percent (calc-top-n 1))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
409 410


411
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
412 413 414 415
(defun calc-over (n)
  (interactive "P")
  (if n
      (calc-enter (- (prefix-numeric-value n)))
416
    (calc-enter -2)))
Eli Zaretskii's avatar
Eli Zaretskii committed
417 418


419
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
420 421 422 423
(defun calc-pop-above (n)
  (interactive "P")
  (if n
      (calc-pop (- (prefix-numeric-value n)))
424
    (calc-pop -2)))
Eli Zaretskii's avatar
Eli Zaretskii committed
425

426
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
427 428 429 430 431 432 433 434 435 436 437 438 439
(defun calc-roll-down (n)
  (interactive "P")
  (calc-wrapper
   (let ((nn (prefix-numeric-value n)))
     (cond ((null n)
	    (calc-roll-down-stack 2))
	   ((> nn 0)
	    (calc-roll-down-stack nn))
	   ((= nn 0)
	    (calc-pop-push-list (calc-stack-size)
				(reverse
				 (calc-top-list (calc-stack-size)))))
	   (t
440
	    (calc-roll-down-stack (calc-stack-size) (- nn)))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
441

442
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
443 444 445 446 447 448 449 450 451 452 453 454 455
(defun calc-roll-up (n)
  (interactive "P")
  (calc-wrapper
   (let ((nn (prefix-numeric-value n)))
     (cond ((null n)
	    (calc-roll-up-stack 3))
	   ((> nn 0)
	    (calc-roll-up-stack nn))
	   ((= nn 0)
	    (calc-pop-push-list (calc-stack-size)
				(reverse
				 (calc-top-list (calc-stack-size)))))
	   (t
456
	    (calc-roll-up-stack (calc-stack-size) (- nn)))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
457

458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570
;;;###autoload
(defun calc-transpose-lines (&optional arg)
  "Transpose previous line and current line.
With argument ARG, move previous line past ARG lines.
With argument 0, switch line point is in with line mark is in."
  (interactive "p")
  (setq arg (or arg 1))
  (let (bot-line mid-line end-line
                 old-top-list new-top-list
                 bot-cell mid-cell
                 prev-mid-cell post-mid-cell post-bot-cell)
    (calc-wrapper
     (when (eq major-mode 'calc-mode)
       (cond
        ;; exchange point and mark
        ((= 0 arg)
         (setq bot-line  (calc-locate-cursor-element (point))
               mid-line  (mark))
         (if mid-line
             (setq mid-line  (calc-locate-cursor-element mid-line)
                   end-line  (1+ mid-line))
           (error "No mark set"))
         (if (< bot-line mid-line)
             (let ((temp mid-line))
               (setq mid-line bot-line
                     bot-line temp))))
        ;; move bot-line to mid-line that is above bot-line on stack (that is
        ;; to say mid-line displayed below bot-line in *Calculator* buffer)
        ((> arg 0)
         (setq bot-line (1+ (calc-locate-cursor-element (point)))
               mid-line (- bot-line arg)
               end-line mid-line))
        ;; move bot-line to mid-line that is above bot-line on stack (that is
        ;; to say mid-line displayed below bot-line in *Calculator* buffer)
        ((< arg 0)
         (setq mid-line (1+ (calc-locate-cursor-element (point)))
               bot-line (- mid-line arg)
               end-line bot-line)))
       (calc-check-stack bot-line)
       (if (= 0 mid-line)
           (error "Can't transpose beyond top"))
       (setq old-top-list (nreverse (calc-top-list bot-line)))
       ;; example: (arg = 2)
       ;; old-top-list =
       ;; 1 <-- top of stack (bottom of *Calculator* buffer)
       ;; 2
       ;; 3 <-- mid-line = 3
       ;; 4 <-- point
       ;; 5 <-- bot-line = 5
       (dotimes (i mid-line)
         (setq mid-cell old-top-list
               old-top-list (cdr old-top-list))
         (setcdr mid-cell new-top-list)
         (setq new-top-list  mid-cell))
       ;; example follow-up:
       ;; old-top-list =
       ;; 4
       ;; 5
       ;; new-top-list =
       ;; 3 <-- mid-cell
       ;; 2
       ;; 1
       (setq  prev-mid-cell old-top-list)
       (dotimes (i (- bot-line mid-line))
         (setq bot-cell old-top-list
               old-top-list (cdr old-top-list))
         (setcdr bot-cell new-top-list)
         (setq new-top-list  bot-cell))
       (setq post-mid-cell (cdr mid-cell)
             post-bot-cell  (cdr bot-cell))
       ;; example follow-up:
       ;; new-top-list =
       ;; 5 <-- bot-cell
       ;; 4 <-- prev-mid-cell & post-bot-cell
       ;; 3 <-- mid-cell
       ;; 2 <-- post-mid-cell
       ;; 1
       (cond
        ((= 0 arg); swap bot and mid
         (setcdr mid-cell            post-bot-cell)
         (setcdr bot-cell            post-mid-cell)
         (setcdr prev-mid-cell       bot-cell)
         ;; example follow-up:
         ;; 3 <-- mid-cell
         ;; 4 <-- post-bot-cell & prev-mid-cell
         ;; 5 <-- bot-cell
         ;; 2 <-- post-mid-cell
         ;; 1
         (setq new-top-list mid-cell))
        ((< 0 arg) ; move bot just after mid
         (setcdr mid-cell       bot-cell)
         (setcdr bot-cell       post-mid-cell)
         ;; example follow-up:
         ;; new-top-list =
         ;; 4 <-- post-bot-cell
         ;; 3 <-- mid-cell
         ;; 5 <-- bot-cell
         ;; 2 <-- post-mid-cell
         ;; 1
         (setq new-top-list post-bot-cell))
        ((> 0 arg) ; move mid just before bot
         (setcdr mid-cell       bot-cell)
         (setcdr prev-mid-cell  post-mid-cell)
         ;; example follow-up:
         ;; new-top-list =
         ;; 3 <-- mid-cell
         ;; 5 <-- bot-cell
         ;; 4 <-- prev-mid-cell
         ;; 2 <-- post-mid-cell
         ;; 1
         (setq new-top-list mid-cell)))
       (calc-pop-push-list bot-line new-top-list)))
    (calc-cursor-stack-index (1- end-line))))
Eli Zaretskii's avatar
Eli Zaretskii committed
571 572 573 574 575



;;; Other commands.

576
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
577 578 579 580 581
(defun calc-num-prefix-name (n)
  (cond ((eq n '-) "- ")
	((equal n '(4)) "C-u ")
	((consp n) (format "%d " (car n)))
	((integerp n) (format "%d " n))
582
	(t "")))
Eli Zaretskii's avatar
Eli Zaretskii committed
583

584
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
585 586 587 588 589
(defun calc-missing-key (n)
  "This is a placeholder for a command which needs to be loaded from calc-ext.
When this key is used, calc-ext (the Calculator extensions module) will be
loaded and the keystroke automatically re-typed."
  (interactive "P")
590
  (require 'calc-ext)
591 592
  (if (keymapp (key-binding (char-to-string last-command-event)))
      (message "%s%c-" (calc-num-prefix-name n) last-command-event))
Eli Zaretskii's avatar
Eli Zaretskii committed
593
  (calc-unread-command)
594
  (setq prefix-arg n))
Eli Zaretskii's avatar
Eli Zaretskii committed
595

596
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
597 598
(defun calc-shift-Y-prefix-help ()
  (interactive)
599
  (require 'calc-ext)
600
  (calc-do-prefix-help calc-Y-help-msgs "other" ?Y))
Eli Zaretskii's avatar
Eli Zaretskii committed
601 602 603 604




605
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
606 607 608 609
(defun calcDigit-letter ()
  (interactive)
  (if (calc-minibuffer-contains "[-+]?\\(1[1-9]\\|[2-9][0-9]\\)#.*")
      (progn
610
	(setq last-command-event (upcase last-command-event))
Eli Zaretskii's avatar
Eli Zaretskii committed
611
	(calcDigit-key))
612
    (calcDigit-nondigit)))
Eli Zaretskii's avatar
Eli Zaretskii committed
613 614 615


;; A Lisp version of temp_minibuffer_message from minibuf.c.
616
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
617 618 619 620 621 622 623 624 625 626 627 628 629
(defun calc-temp-minibuffer-message (m)
  (let ((savemax (point-max)))
    (save-excursion
      (goto-char (point-max))
      (insert m))
    (let ((okay nil))
      (unwind-protect
	  (progn
	    (sit-for 2)
	    (identity 1)   ; this forces a call to QUIT; in bytecode.c.
	    (setq okay t))
	(progn
	  (delete-region savemax (point-max))
630
	  (or okay (abort-recursive-edit)))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
631 632 633 634 635


(put 'math-with-extra-prec 'lisp-indent-hook 1)


636 637
;; Concatenate two vectors, or a vector and an object.  [V O O] [Public]
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
638 639 640
(defun math-concat (v1 v2)
  (if (stringp v1)
      (concat v1 v2)
641
    (require 'calc-ext)
Eli Zaretskii's avatar
Eli Zaretskii committed
642 643 644 645 646 647 648 649 650 651 652 653
    (if (and (or (math-objvecp v1) (math-known-scalarp v1))
	     (or (math-objvecp v2) (math-known-scalarp v2)))
	(append (if (and (math-vectorp v1)
			 (or (math-matrixp v1)
			     (not (math-matrixp v2))))
		    v1
		  (list 'vec v1))
		(if (and (math-vectorp v2)
			 (or (math-matrixp v2)
			     (not (math-matrixp v1))))
		    (cdr v2)
		  (list v2)))
654
      (list '| v1 v2))))
Eli Zaretskii's avatar
Eli Zaretskii committed
655 656


657 658
;; True if A is zero.  Works for un-normalized values.  [P n] [Public]
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
659 660 661 662 663 664 665 666 667 668 669 670 671
(defun math-zerop (a)
  (if (consp a)
      (cond ((memq (car a) '(bigpos bigneg))
	     (while (eq (car (setq a (cdr a))) 0))
	     (null a))
	    ((memq (car a) '(frac float polar mod))
	     (math-zerop (nth 1 a)))
	    ((eq (car a) 'cplx)
	     (and (math-zerop (nth 1 a)) (math-zerop (nth 2 a))))
	    ((eq (car a) 'hms)
	     (and (math-zerop (nth 1 a))
		  (math-zerop (nth 2 a))
		  (math-zerop (nth 3 a)))))
672
    (eq a 0)))
Eli Zaretskii's avatar
Eli Zaretskii committed
673 674


675
;; True if A is real and negative.  [P n] [Public]
Eli Zaretskii's avatar
Eli Zaretskii committed
676

677
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696
(defun math-negp (a)
  (if (consp a)
      (cond ((eq (car a) 'bigpos) nil)
	    ((eq (car a) 'bigneg) (cdr a))
	    ((memq (car a) '(float frac))
	     (Math-integer-negp (nth 1 a)))
	    ((eq (car a) 'hms)
	     (if (math-zerop (nth 1 a))
		 (if (math-zerop (nth 2 a))
		     (math-negp (nth 3 a))
		   (math-negp (nth 2 a)))
	       (math-negp (nth 1 a))))
	    ((eq (car a) 'date)
	     (math-negp (nth 1 a)))
	    ((eq (car a) 'intv)
	     (or (math-negp (nth 3 a))
		 (and (math-zerop (nth 3 a))
		      (memq (nth 1 a) '(0 2)))))
	    ((equal a '(neg (var inf var-inf))) t))
697
    (< a 0)))
Eli Zaretskii's avatar
Eli Zaretskii committed
698

699 700
;; True if A is a negative number or an expression the starts with '-'.
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
701 702 703 704 705 706 707
(defun math-looks-negp (a)   ; [P x] [Public]
  (or (Math-negp a)
      (eq (car-safe a) 'neg)
      (and (memq (car-safe a) '(* /))
	   (or (math-looks-negp (nth 1 a))
	       (math-looks-negp (nth 2 a))))
      (and (eq (car-safe a) '-)
708
	   (math-looks-negp (nth 1 a)))))
Eli Zaretskii's avatar
Eli Zaretskii committed
709 710


711 712
;; True if A is real and positive.  [P n] [Public]
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733
(defun math-posp (a)
  (if (consp a)
      (cond ((eq (car a) 'bigpos) (cdr a))
	    ((eq (car a) 'bigneg) nil)
	    ((memq (car a) '(float frac))
	     (Math-integer-posp (nth 1 a)))
	    ((eq (car a) 'hms)
	     (if (math-zerop (nth 1 a))
		 (if (math-zerop (nth 2 a))
		     (math-posp (nth 3 a))
		   (math-posp (nth 2 a)))
	       (math-posp (nth 1 a))))
	    ((eq (car a) 'date)
	     (math-posp (nth 1 a)))
	    ((eq (car a) 'mod)
	     (not (math-zerop (nth 1 a))))
	    ((eq (car a) 'intv)
	     (or (math-posp (nth 2 a))
		 (and (math-zerop (nth 2 a))
		      (memq (nth 1 a) '(0 1)))))
	    ((equal a '(var inf var-inf)) t))
734
    (> a 0)))
Eli Zaretskii's avatar
Eli Zaretskii committed
735

736
;;;###autoload
737
(defalias 'math-fixnump 'integerp)
738
;;;###autoload
739
(defalias 'math-fixnatnump 'natnump)
Eli Zaretskii's avatar
Eli Zaretskii committed
740 741


742 743
;; True if A is an even integer.  [P R R] [Public]
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
744 745 746 747
(defun math-evenp (a)
  (if (consp a)
      (and (memq (car a) '(bigpos bigneg))
	   (= (% (nth 1 a) 2) 0))
748
    (= (% a 2) 0)))
Eli Zaretskii's avatar
Eli Zaretskii committed
749

750 751 752
;; Compute A / 2, for small or big integer A.  [I i]
;; If A is negative, type of truncation is undefined.
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
753 754 755 756 757
(defun math-div2 (a)
  (if (consp a)
      (if (cdr a)
	  (math-normalize (cons (car a) (math-div2-bignum (cdr a))))
	0)
758
    (/ a 2)))
Eli Zaretskii's avatar
Eli Zaretskii committed
759

760
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
761 762
(defun math-div2-bignum (a)   ; [l l]
  (if (cdr a)
763
      (cons (+ (/ (car a) 2) (* (% (nth 1 a) 2) (/ math-bignum-digit-size 2)))
Eli Zaretskii's avatar
Eli Zaretskii committed
764
	    (math-div2-bignum (cdr a)))
765
    (list (/ (car a) 2))))
Eli Zaretskii's avatar
Eli Zaretskii committed
766 767


768 769
;; Reject an argument to a calculator function.  [Public]
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
770 771 772 773 774
(defun math-reject-arg (&optional a p option)
  (if option
      (calc-record-why option p a)
    (if p
	(calc-record-why p a)))
775
  (signal 'wrong-type-argument (and a (if p (list p a) (list a)))))
Eli Zaretskii's avatar
Eli Zaretskii committed
776 777


778
;; Coerce A to be an integer (by truncation toward zero).  [I N] [Public]
779 780 781 782

;; The variable math-trunc-prec is local to math-trunc, but used by
;; math-trunc-fancy in calc-arith.el, which is called by math-trunc.

783
;;;###autoload
784 785
(defun math-trunc (a &optional math-trunc-prec)
  (cond (math-trunc-prec
786
	 (require 'calc-ext)
787
	 (math-trunc-special a math-trunc-prec))
Eli Zaretskii's avatar
Eli Zaretskii committed
788 789 790 791 792
	((Math-integerp a) a)
	((Math-looks-negp a)
	 (math-neg (math-trunc (math-neg a))))
	((eq (car a) 'float)
	 (math-scale-int (nth 1 a) (nth 2 a)))
793
	(t (require 'calc-ext)
794
	   (math-trunc-fancy a))))
795
;;;###autoload
796
(defalias 'calcFunc-trunc 'math-trunc)
Eli Zaretskii's avatar
Eli Zaretskii committed
797

798
;; Coerce A to be an integer (by truncation toward minus infinity).  [I N]
799 800 801 802

;; The variable math-floor-prec is local to math-floor, but used by
;; math-floor-fancy in calc-arith.el, which is called by math-floor.

803
;;;###autoload
804 805
(defun math-floor (a &optional math-floor-prec)    ;  [Public]
  (cond (math-floor-prec
806
	 (require 'calc-ext)
807
	 (math-floor-special a math-floor-prec))
Eli Zaretskii's avatar
Eli Zaretskii committed
808 809 810 811 812 813
	((Math-integerp a) a)
	((Math-messy-integerp a) (math-trunc a))
	((Math-realp a)
	 (if (Math-negp a)
	     (math-add (math-trunc a) -1)
	   (math-trunc a)))
814
	(t (require 'calc-ext)
815
	   (math-floor-fancy a))))
816
;;;###autoload
817
(defalias 'calcFunc-floor 'math-floor)
Eli Zaretskii's avatar
Eli Zaretskii committed
818 819


820
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
821 822 823 824 825
(defun math-imod (a b)   ; [I I I] [Public]
  (if (and (not (consp a)) (not (consp b)))
      (if (= b 0)
	  (math-reject-arg a "*Division by zero")
	(% a b))
826
    (cdr (math-idivmod a b))))
Eli Zaretskii's avatar
Eli Zaretskii committed
827 828


829
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
830 831 832
(defun calcFunc-inv (m)
  (if (Math-vectorp m)
      (progn
833
	(require 'calc-ext)
Eli Zaretskii's avatar
Eli Zaretskii committed
834 835 836 837
	(if (math-square-matrixp m)
	    (or (math-with-extra-prec 2 (math-matrix-inv-raw m))
		(math-reject-arg m "*Singular matrix"))
	  (math-reject-arg m 'square-matrixp)))
838 839 840 841 842
    (if (and
         (require 'calc-arith)
         (math-known-matrixp m))
        (math-pow m -1)
      (math-div 1 m))))
Eli Zaretskii's avatar
Eli Zaretskii committed
843

844
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
845
(defun math-do-working (msg arg)
846
  (or executing-kbd-macro
Eli Zaretskii's avatar
Eli Zaretskii committed
847 848 849 850 851 852 853 854
      (progn
	(calc-set-command-flag 'clear-message)
	(if math-working-step
	    (if math-working-step-2
		(setq msg (format "[%d/%d] %s"
				  math-working-step math-working-step-2 msg))
	      (setq msg (format "[%d] %s" math-working-step msg))))
	(message "Working... %s = %s" msg
855
		 (math-showing-full-precision (math-format-number arg))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
856 857


858 859
;; Compute A modulo B, defined in terms of truncation toward minus infinity.
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
860 861 862 863 864 865 866 867
(defun math-mod (a b)   ; [R R R] [Public]
  (cond ((and (Math-zerop a) (not (eq (car-safe a) 'mod))) a)
	((Math-zerop b)
	 (math-reject-arg a "*Division by zero"))
	((and (Math-natnump a) (Math-natnump b))
	 (math-imod a b))
	((and (Math-anglep a) (Math-anglep b))
	 (math-sub a (math-mul (math-floor (math-div a b)) b)))
868
	(t (require 'calc-ext)
869
	   (math-mod-fancy a b))))
Eli Zaretskii's avatar
Eli Zaretskii committed
870 871 872 873 874



;;; General exponentiation.

875
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
876 877 878 879 880 881
(defun math-pow (a b)   ; [O O N] [Public]
  (cond ((equal b '(var nan var-nan))
	 b)
	((Math-zerop a)
	 (if (and (Math-scalarp b) (Math-posp b))
	     (if (math-floatp b) (math-float a) a)
882
	   (require 'calc-ext)
Eli Zaretskii's avatar
Eli Zaretskii committed
883 884 885 886 887 888 889
	   (math-pow-of-zero a b)))
	((or (eq a 1) (eq b 1)) a)
	((or (equal a '(float 1 0)) (equal b '(float 1 0))) a)
	((Math-zerop b)
	 (if (Math-scalarp a)
	     (if (or (math-floatp a) (math-floatp b))
		 '(float 1 0) 1)
890
	   (require 'calc-ext)
Eli Zaretskii's avatar
Eli Zaretskii committed
891 892 893 894 895 896 897
	   (math-pow-zero a b)))
	((and (Math-integerp b) (or (Math-numberp a) (Math-vectorp a)))
	 (if (and (equal a '(float 1 1)) (integerp b))
	     (math-make-float 1 b)
	   (math-with-extra-prec 2
	     (math-ipow a b))))
	(t
898
	 (require 'calc-ext)
899
	 (math-pow-fancy a b))))
Eli Zaretskii's avatar
Eli Zaretskii committed
900

901
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
902 903 904 905 906 907 908 909 910 911 912
(defun math-ipow (a n)   ; [O O I] [Public]
  (cond ((Math-integer-negp n)
	 (math-ipow (math-div 1 a) (Math-integer-neg n)))
	((not (consp n))
	 (if (and (Math-ratp a) (> n 20))
	     (math-iipow-show a n)
	   (math-iipow a n)))
	((math-evenp n)
	 (math-ipow (math-mul a a) (math-div2 n)))
	(t
	 (math-mul a (math-ipow (math-mul a a)
913
				(math-div2 (math-add n -1)))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
914 915 916 917 918

(defun math-iipow (a n)   ; [O O S]
  (cond ((= n 0) 1)
	((= n 1) a)
	((= (% n 2) 0) (math-iipow (math-mul a a) (/ n 2)))
919
	(t (math-mul a (math-iipow (math-mul a a) (/ n 2))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
920 921 922 923 924 925 926 927 928

(defun math-iipow-show (a n)   ; [O O S]
  (math-working "pow" a)
  (let ((val (cond
	      ((= n 0) 1)
	      ((= n 1) a)
	      ((= (% n 2) 0) (math-iipow-show (math-mul a a) (/ n 2)))
	      (t (math-mul a (math-iipow-show (math-mul a a) (/ n 2)))))))
    (math-working "pow" val)
929
    val))
Eli Zaretskii's avatar
Eli Zaretskii committed
930 931


932
;;;###autoload
Eli Zaretskii's avatar
Eli Zaretskii committed
933 934 935 936 937 938 939
(defun math-read-radix-digit (dig)   ; [D S; Z S]
  (if (> dig ?9)
      (if (< dig ?A)
	  nil
	(- dig 55))
    (if (>= dig ?0)
	(- dig ?0)
940
      nil)))
Eli Zaretskii's avatar
Eli Zaretskii committed
941 942 943 944


;;; Bug reporting

945
;;;###autoload
946
(defun report-calc-bug ()
Eli Zaretskii's avatar
Eli Zaretskii committed
947 948
  "Report a bug in Calc, the GNU Emacs calculator.
Prompts for bug subject.  Leaves you in a mail buffer."
949 950
  (interactive)
  (let ((reporter-prompt-for-summary-p t))
951 952
    (reporter-submit-bug-report calc-bug-address "Calc"
				nil nil nil
953
				"Please describe exactly what actions triggered the bug and the
954 955
precise symptoms of the bug.  If possible, include a backtrace by
doing 'M-x toggle-debug-on-error', then reproducing the bug.
956
" )))
957
;;;###autoload
958
(defalias 'calc-report-bug 'report-calc-bug)
Eli Zaretskii's avatar
Eli Zaretskii committed
959

Jay Belanger's avatar
Jay Belanger committed
960 961
(provide 'calc-misc)

962 963 964 965
;; Local variables:
;; generated-autoload-file: "calc-loaddefs.el"
;; End:

966
;;; calc-misc.el ends here