lisp/calc/calc-misc.el

   1 ;;; calc-misc.el --- miscellaneous functions for Calc
   2
   3 ;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
   4
   5 ;; Author: David Gillespie <daveg@synaptics.com>
   6 ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
   7
   8 ;; This file is part of GNU Emacs.
   9
  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 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; 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/>.
  22
  23 ;;; Commentary:
  24
  25 ;;; Code:
  26
  27 ;; This file is autoloaded from calc.el.
  28
  29 (require 'calc)
  30 (require 'calc-macs)
  31
  32 ;; Declare functions which are defined elsewhere.
  33 (declare-function calc-do-keypad "calc-keypd" (&optional full-display interactive))
  34 (declare-function calc-inv-hyp-prefix-help "calc-help" ())
  35 (declare-function calc-inverse-prefix-help "calc-help" ())
  36 (declare-function calc-hyperbolic-prefix-help "calc-help" ())
  37 (declare-function calc-option-prefix-help "calc-help" ())
  38 (declare-function calc-explain-why "calc-stuff" (why &optional more))
  39 (declare-function calc-clear-command-flag "calc-ext" (f))
  40 (declare-function calc-roll-down-with-selections "calc-sel" (n m))
  41 (declare-function calc-roll-up-with-selections "calc-sel" (n m))
  42 (declare-function calc-last-args "calc-undo" (n))
  43 (declare-function calc-is-inverse "calc-ext" ())
  44 (declare-function calc-do-prefix-help "calc-ext" (msgs group key))
  45 (declare-function math-objvecp "calc-ext" (a))
  46 (declare-function math-known-scalarp "calc-arith" (a &optional assume-scalar))
  47 (declare-function math-vectorp "calc-ext" (a))
  48 (declare-function math-matrixp "calc-ext" (a))
  49 (declare-function math-trunc-special "calc-arith" (a prec))
  50 (declare-function math-trunc-fancy "calc-arith" (a))
  51 (declare-function math-floor-special "calc-arith" (a prec))
  52 (declare-function math-floor-fancy "calc-arith" (a))
  53 (declare-function math-square-matrixp "calc-ext" (a))
  54 (declare-function math-matrix-inv-raw "calc-mtx" (m))
  55 (declare-function math-known-matrixp "calc-arith" (a))
  56 (declare-function math-mod-fancy "calc-arith" (a b))
  57 (declare-function math-pow-of-zero "calc-arith" (a b))
  58 (declare-function math-pow-zero "calc-arith" (a b))
  59 (declare-function math-pow-fancy "calc-arith" (a b))
  60 (declare-function calc-locate-cursor-element "calc-yank" (pt))
  61
  62 ;;;###autoload
  63 (defun calc-dispatch-help (arg)
  64   "C-x* is a prefix key sequence; follow it with one of these letters:
  65
  66 For turning Calc on and off:
  67   C  calc.  Start the Calculator in a window at the bottom of the screen.
  68   O  calc-other-window.  Start the Calculator but don't select its window.
  69   B  calc-big-or-small.  Control whether to use the full Emacs screen for Calc.
  70   Q  quick-calc.  Use the Calculator in the minibuffer.
  71   K  calc-keypad.  Start the Calculator in keypad mode (X window system only).
  72   E  calc-embedded.  Use the Calculator on a formula in this editing buffer.
  73   J  calc-embedded-select.  Like E, but select appropriate half of => or :=.
  74   W  calc-embedded-word.  Like E, but activate a single word, i.e., a number.
  75   Z  calc-user-invocation.  Invoke Calc in the way you defined with `Z I' cmd.
  76   X  calc-quit.  Turn Calc off.
  77
  78 For moving data into and out of Calc:
  79   G  calc-grab-region.  Grab the region defined by mark and point into Calc.
  80   R  calc-grab-rectangle.  Grab the rectangle defined by mark, point into Calc.
  81   :  calc-grab-sum-down.  Grab a rectangle and sum the columns.
  82   _  calc-grab-sum-across.  Grab a rectangle and sum the rows.
  83   Y  calc-copy-to-buffer.  Copy a value from the stack into the editing buffer.
  84
  85 For use with Embedded mode:
  86   A  calc-embedded-activate.  Find and activate all :='s and =>'s in buffer.
  87   D  calc-embedded-duplicate.  Make a copy of this formula and select it.
  88   F  calc-embedded-new-formula.  Insert a new formula at current point.
  89   N  calc-embedded-next.  Advance cursor to next known formula in buffer.
  90   P  calc-embedded-previous.  Advance cursor to previous known formula.
  91   U  calc-embedded-update-formula.  Re-evaluate formula at point.
  92   `  calc-embedded-edit.  Use calc-edit to edit formula at point.
  93
  94 Documentation:
  95   I  calc-info.  Read the Calculator manual in the Emacs Info system.
  96   T  calc-tutorial.  Run the Calculator Tutorial using the Emacs Info system.
  97   S  calc-summary.  Read the Summary from the Calculator manual in Info.
  98
  99 Miscellaneous:
 100   L  calc-load-everything.  Load all parts of the Calculator into memory.
 101   M  read-kbd-macro.  Read a region of keystroke names as a keyboard macro.
 102   0  (zero) calc-reset.  Reset Calc stack and modes to default state.
 103
 104 Press `*' twice (`C-x * *') to turn Calc on or off using the same
 105 Calc user interface as before (either C-x * C or C-x * K; initially C-x * C).
 106 "
 107   (interactive "P")
 108   (calc-check-defines)
 109   (if calc-dispatch-help
 110       (progn
 111         (save-window-excursion
 112           (describe-function 'calc-dispatch-help)
 113           (let ((win (get-buffer-window "*Help*")))
 114             (if win
 115                 (let (key)
 116                   (select-window win)
 117                   (while (progn
 118                            (message "Calc options: Calc, Keypad, ...  %s"
 119                                     "press SPC, DEL to scroll, C-g to cancel")
 120                            (memq (car (setq key (calc-read-key t)))
 121                                  '(?  ?\C-h ?\C-? ?\C-v ?\M-v)))
 122                     (condition-case err
 123                         (if (memq (car key) '(?  ?\C-v))
 124                             (scroll-up)
 125                           (scroll-down))
 126                       (error (beep))))
 127                       (calc-unread-command (cdr key))))))
 128         (calc-do-dispatch nil))
 129     (let ((calc-dispatch-help t))
 130       (calc-do-dispatch arg))))
 131
 132
 133 ;;;###autoload
 134 (defun calc-big-or-small (arg)
 135   "Toggle Calc between full-screen and regular mode."
 136   (interactive "P")
 137   (let ((cwin (get-buffer-window "*Calculator*"))
 138         (twin (get-buffer-window "*Calc Trail*"))
 139         (kwin (get-buffer-window "*Calc Keypad*")))
 140     (if cwin
 141         (setq calc-full-mode
 142               (if kwin
 143                   (and twin (window-full-width-p twin))
 144                 (window-full-height-p cwin))))
 145     (setq calc-full-mode (if arg
 146                              (> (prefix-numeric-value arg) 0)
 147                            (not calc-full-mode)))
 148     (if kwin
 149         (progn
 150           (calc-quit)
 151           (calc-do-keypad calc-full-mode nil))
 152       (if cwin
 153           (progn
 154             (calc-quit)
 155             (calc nil calc-full-mode nil))))
 156     (message (if calc-full-mode
 157                  "Now using full screen for Calc"
 158                "Now using partial screen for Calc"))))
 159
 160 ;;;###autoload
 161 (defun calc-other-window (&optional interactive)
 162   "Invoke the Calculator in another window."
 163   (interactive "p")
 164   (if (memq major-mode '(calc-mode calc-trail-mode))
 165       (progn
 166         (other-window 1)
 167         (if (memq major-mode '(calc-mode calc-trail-mode))
 168             (other-window 1)))
 169     (if (get-buffer-window "*Calculator*")
 170         (calc-quit)
 171       (let ((win (selected-window)))
 172         (calc nil win interactive)))))
 173
 174 ;;;###autoload
 175 (defun another-calc ()
 176   "Create another, independent Calculator buffer."
 177   (interactive)
 178   (if (eq major-mode 'calc-mode)
 179       (mapc (function
 180              (lambda (v)
 181               (set-default v (symbol-value v)))) calc-local-var-list))
 182   (set-buffer (generate-new-buffer "*Calculator*"))
 183   (pop-to-buffer (current-buffer))
 184   (calc-mode))
 185
 186 ;;;###autoload
 187 (defun calc-info ()
 188   "Run the Emacs Info system on the Calculator documentation."
 189   (interactive)
 190   (select-window (get-largest-window))
 191   (info "Calc"))
 192
 193 ;;;###autoload
 194 (defun calc-info-goto-node (node)
 195   "Go to a node in the Calculator info documentation."
 196   (interactive)
 197   (select-window (get-largest-window))
 198   (info (concat "(Calc)" node)))
 199
 200 ;;;###autoload
 201 (defun calc-tutorial ()
 202   "Run the Emacs Info system on the Calculator Tutorial."
 203   (interactive)
 204   (if (get-buffer-window "*Calculator*")
 205       (calc-quit))
 206   (calc-info-goto-node "Interactive Tutorial")
 207   (calc-other-window)
 208   (message "Welcome to the Calc Tutorial!"))
 209
 210 ;;;###autoload
 211 (defun calc-info-summary ()
 212   "Run the Emacs Info system on the Calculator Summary."
 213   (interactive)
 214   (calc-info-goto-node "Summary"))
 215
 216 ;;;###autoload
 217 (defun calc-help ()
 218   (interactive)
 219   (let ((msgs
 220          '("Press `h' for complete help; press `?' repeatedly for a summary"
 221            "Letter keys: Negate; Precision; Yank; Why; Xtended cmd; Quit"
 222            "Letter keys: SHIFT + Undo, reDo; Keep-args; Inverse, Hyperbolic, Option"
 223            "Letter keys: SHIFT + sQrt; Sin, Cos, Tan; Exp, Ln, logB"
 224            "Letter keys: SHIFT + Floor, Round; Abs, conJ, arG; Pi"
 225            "Letter keys: SHIFT + Num-eval; More-recn; eXec-kbd-macro"
 226            "Other keys: +, -, *, /, ^, \\ (int div), : (frac div)"
 227            "Other keys: & (1/x), | (concat), % (modulo), ! (factorial)"
 228            "Other keys: ' (alg-entry), = (eval), ` (edit); M-RET (last-args)"
 229            "Other keys: SPC/RET (enter/dup), LFD (over); < > (scroll horiz)"
 230            "Other keys: DEL (drop), M-DEL (drop-above); { } (scroll vert)"
 231            "Other keys: TAB (swap/roll-dn), M-TAB (roll-up)"
 232            "Other keys: [ , ; ] (vector), ( , ) (complex), ( ; ) (polar)"
 233            "Prefix keys: Algebra, Binary/business, Convert, Display"
 234            "Prefix keys: Functions, Graphics, Help, J (select)"
 235            "Prefix keys: Kombinatorics/statistics, Modes, Store/recall"
 236            "Prefix keys: Trail/time, Units/statistics, Vector/matrix"
 237            "Prefix keys: Z (user), SHIFT + Z (define)"
 238            "Prefix keys: prefix + ? gives further help for that prefix"
 239            "  Calc by Dave Gillespie, daveg@synaptics.com")))
 240     (if calc-full-help-flag
 241         msgs
 242       (if (or calc-inverse-flag calc-hyperbolic-flag)
 243           (if calc-inverse-flag
 244               (if calc-hyperbolic-flag
 245                   (calc-inv-hyp-prefix-help)
 246                 (calc-inverse-prefix-help))
 247             (calc-hyperbolic-prefix-help))
 248         (if calc-option-flag
 249             (calc-option-prefix-help)
 250           (setq calc-help-phase
 251                 (if (eq this-command last-command)
 252                     (% (1+ calc-help-phase) (1+ (length msgs)))
 253                   0))
 254           (let ((msg (nth calc-help-phase msgs)))
 255             (message "%s" (if msg
 256                               (concat msg ":"
 257                                       (make-string (- (apply 'max
 258                                                              (mapcar 'length
 259                                                                      msgs))
 260                                                       (length msg)) 32)
 261                                       "  [?=MORE]")
 262                             ""))))))))
 263
 264
 265
 266
 267 ;;;; Stack and buffer management.
 268
 269 ;; The variable calc-last-why-command is set in calc-do-handly-whys
 270 ;; and used in calc-why (in calc-stuff.el).
 271 (defvar calc-last-why-command)
 272
 273 ;;;###autoload
 274 (defun calc-do-handle-whys ()
 275   (setq calc-why (sort calc-next-why
 276                        (function
 277                         (lambda (x y)
 278                           (and (eq (car x) '*) (not (eq (car y) '*))))))
 279         calc-next-why nil)
 280   (if (and calc-why (or (eq calc-auto-why t)
 281                         (and (eq (car (car calc-why)) '*)
 282                              calc-auto-why)))
 283       (progn
 284         (require 'calc-ext)
 285         (calc-explain-why (car calc-why)
 286                           (if (eq calc-auto-why t)
 287                               (cdr calc-why)
 288                             (if calc-auto-why
 289                                 (eq (car (nth 1 calc-why)) '*))))
 290         (setq calc-last-why-command this-command)
 291         (calc-clear-command-flag 'clear-message))))
 292
 293 ;;;###autoload
 294 (defun calc-record-why (&rest stuff)
 295   (if (eq (car stuff) 'quiet)
 296       (setq stuff (cdr stuff))
 297     (if (and (symbolp (car stuff))
 298              (cdr 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)
 307                                      (cdr stuff)))))))
 308   (setq calc-next-why (cons stuff calc-next-why))
 309   nil)
 310
 311 ;; True if A is a constant or vector of constants.  [P x] [Public]
 312 ;;;###autoload
 313 (defun math-constp (a)
 314   (or (Math-scalarp a)
 315       (and (memq (car a) '(sdev intv mod vec))
 316            (progn
 317              (while (and (setq a (cdr a))
 318                          (or (Math-scalarp (car a))  ; optimization
 319                              (math-constp (car a)))))
 320              (null a)))))
 321
 322
 323 ;;;###autoload
 324 (defun calc-roll-down-stack (n &optional m)
 325   (if (< n 0)
 326       (calc-roll-up-stack (- n) m)
 327     (if (or (= n 0) (> n (calc-stack-size))) (setq n (calc-stack-size)))
 328     (or m (setq m 1))
 329     (and (> n 1)
 330          (< m n)
 331          (if (and calc-any-selections
 332                   (not calc-use-selections))
 333              (calc-roll-down-with-selections n m)
 334            (calc-pop-push-list n
 335                                (append (calc-top-list m 1)
 336                                        (calc-top-list (- n m) (1+ m))))))))
 337
 338 ;;;###autoload
 339 (defun calc-roll-up-stack (n &optional m)
 340   (if (< n 0)
 341       (calc-roll-down-stack (- n) m)
 342     (if (or (= n 0) (> n (calc-stack-size))) (setq n (calc-stack-size)))
 343     (or m (setq m 1))
 344     (and (> n 1)
 345          (< m n)
 346          (if (and calc-any-selections
 347                   (not calc-use-selections))
 348              (calc-roll-up-with-selections n m)
 349            (calc-pop-push-list n
 350                                (append (calc-top-list (- n m) 1)
 351                                        (calc-top-list m (- n m -1))))))))
 352
 353
 354 ;;;###autoload
 355 (defun calc-do-refresh ()
 356   (if calc-hyperbolic-flag
 357       (progn
 358         (setq calc-display-dirty t)
 359         nil)
 360     (calc-refresh)
 361     t))
 362
 363
 364 ;;;###autoload
 365 (defun calc-record-list (vals &optional prefix)
 366   (while vals
 367     (or (eq (car vals) 'top-of-stack)
 368         (progn
 369           (calc-record (car vals) prefix)
 370           (setq prefix "...")))
 371     (setq vals (cdr vals))))
 372
 373
 374 ;;;###autoload
 375 (defun calc-last-args-stub (arg)
 376   (interactive "p")
 377   (require 'calc-ext)
 378   (calc-last-args arg))
 379
 380
 381 ;;;###autoload
 382 (defun calc-power (arg)
 383   (interactive "P")
 384   (calc-slow-wrapper
 385    (if (and (featurep 'calc-ext)
 386             (calc-is-inverse))
 387        (calc-binary-op "root" 'calcFunc-nroot arg nil nil)
 388      (calc-binary-op "^" 'calcFunc-pow arg nil nil '^))))
 389
 390 ;;;###autoload
 391 (defun calc-mod (arg)
 392   (interactive "P")
 393   (calc-slow-wrapper
 394    (calc-binary-op "%" 'calcFunc-mod arg nil nil '%)))
 395
 396 ;;;###autoload
 397 (defun calc-inv (arg)
 398   (interactive "P")
 399   (calc-slow-wrapper
 400    (calc-unary-op "inv" 'calcFunc-inv arg)))
 401
 402 ;;;###autoload
 403 (defun calc-percent ()
 404   (interactive)
 405   (calc-slow-wrapper
 406    (calc-pop-push-record-list
 407     1 "%" (list (list 'calcFunc-percent (calc-top-n 1))))))
 408
 409
 410 ;;;###autoload
 411 (defun calc-over (n)
 412   (interactive "P")
 413   (if n
 414       (calc-enter (- (prefix-numeric-value n)))
 415     (calc-enter -2)))
 416
 417
 418 ;;;###autoload
 419 (defun calc-pop-above (n)
 420   (interactive "P")
 421   (if n
 422       (calc-pop (- (prefix-numeric-value n)))
 423     (calc-pop -2)))
 424
 425 ;;;###autoload
 426 (defun calc-roll-down (n)
 427   (interactive "P")
 428   (calc-wrapper
 429    (let ((nn (prefix-numeric-value n)))
 430      (cond ((null n)
 431             (calc-roll-down-stack 2))
 432            ((> nn 0)
 433             (calc-roll-down-stack nn))
 434            ((= nn 0)
 435             (calc-pop-push-list (calc-stack-size)
 436                                 (reverse
 437                                  (calc-top-list (calc-stack-size)))))
 438            (t
 439             (calc-roll-down-stack (calc-stack-size) (- nn)))))))
 440
 441 ;;;###autoload
 442 (defun calc-roll-up (n)
 443   (interactive "P")
 444   (calc-wrapper
 445    (let ((nn (prefix-numeric-value n)))
 446      (cond ((null n)
 447             (calc-roll-up-stack 3))
 448            ((> nn 0)
 449             (calc-roll-up-stack nn))
 450            ((= nn 0)
 451             (calc-pop-push-list (calc-stack-size)
 452                                 (reverse
 453                                  (calc-top-list (calc-stack-size)))))
 454            (t
 455             (calc-roll-up-stack (calc-stack-size) (- nn)))))))
 456
 457 ;;;###autoload
 458 (defun calc-transpose-lines (&optional arg)
 459   "Transpose previous line and current line.
 460 With argument ARG, move previous line past ARG lines.
 461 With argument 0, switch line point is in with line mark is in."
 462   (interactive "p")
 463   (setq arg (or arg 1))
 464   (let (bot-line mid-line end-line
 465                  old-top-list new-top-list
 466                  bot-cell mid-cell
 467                  prev-mid-cell post-mid-cell post-bot-cell)
 468     (calc-wrapper
 469      (when (eq major-mode 'calc-mode)
 470        (cond
 471         ;; exchange point and mark
 472         ((= 0 arg)
 473          (setq bot-line  (calc-locate-cursor-element (point))
 474                mid-line  (mark))
 475          (if mid-line
 476              (setq mid-line  (calc-locate-cursor-element mid-line)
 477                    end-line  (1+ mid-line))
 478            (error "No mark set"))
 479          (if (< bot-line mid-line)
 480              (let ((temp mid-line))
 481                (setq mid-line bot-line
 482                      bot-line temp))))
 483         ;; move bot-line to mid-line that is above bot-line on stack (that is
 484         ;; to say mid-line displayed below bot-line in *Calculator* buffer)
 485         ((> arg 0)
 486          (setq bot-line (1+ (calc-locate-cursor-element (point)))
 487                mid-line (- bot-line arg)
 488                end-line mid-line))
 489         ;; move bot-line to mid-line that is above bot-line on stack (that is
 490         ;; to say mid-line displayed below bot-line in *Calculator* buffer)
 491         ((< arg 0)
 492          (setq mid-line (1+ (calc-locate-cursor-element (point)))
 493                bot-line (- mid-line arg)
 494                end-line bot-line)))
 495        (calc-check-stack bot-line)
 496        (if (= 0 mid-line)
 497            (error "Can't transpose beyond top"))
 498        (setq old-top-list (nreverse (calc-top-list bot-line)))
 499        ;; example: (arg = 2)
 500        ;; old-top-list =
 501        ;; 1 <-- top of stack (bottom of *Calculator* buffer)
 502        ;; 2
 503        ;; 3 <-- mid-line = 3
 504        ;; 4 <-- point
 505        ;; 5 <-- bot-line = 5
 506        (dotimes (i mid-line)
 507          (setq mid-cell old-top-list
 508                old-top-list (cdr old-top-list))
 509          (setcdr mid-cell new-top-list)
 510          (setq new-top-list  mid-cell))
 511        ;; example follow-up:
 512        ;; old-top-list =
 513        ;; 4
 514        ;; 5
 515        ;; new-top-list =
 516        ;; 3 <-- mid-cell
 517        ;; 2
 518        ;; 1
 519        (setq  prev-mid-cell old-top-list)
 520        (dotimes (i (- bot-line mid-line))
 521          (setq bot-cell old-top-list
 522                old-top-list (cdr old-top-list))
 523          (setcdr bot-cell new-top-list)
 524          (setq new-top-list  bot-cell))
 525        (setq post-mid-cell (cdr mid-cell)
 526              post-bot-cell  (cdr bot-cell))
 527        ;; example follow-up:
 528        ;; new-top-list =
 529        ;; 5 <-- bot-cell
 530        ;; 4 <-- prev-mid-cell & post-bot-cell
 531        ;; 3 <-- mid-cell
 532        ;; 2 <-- post-mid-cell
 533        ;; 1
 534        (cond
 535         ((= 0 arg); swap bot and mid
 536          (setcdr mid-cell            post-bot-cell)
 537          (setcdr bot-cell            post-mid-cell)
 538          (setcdr prev-mid-cell       bot-cell)
 539          ;; example follow-up:
 540          ;; 3 <-- mid-cell
 541          ;; 4 <-- post-bot-cell & prev-mid-cell
 542          ;; 5 <-- bot-cell
 543          ;; 2 <-- post-mid-cell
 544          ;; 1
 545          (setq new-top-list mid-cell))
 546         ((< 0 arg) ; move bot just after mid
 547          (setcdr mid-cell       bot-cell)
 548          (setcdr bot-cell       post-mid-cell)
 549          ;; example follow-up:
 550          ;; new-top-list =
 551          ;; 4 <-- post-bot-cell
 552          ;; 3 <-- mid-cell
 553          ;; 5 <-- bot-cell
 554          ;; 2 <-- post-mid-cell
 555          ;; 1
 556          (setq new-top-list post-bot-cell))
 557         ((> 0 arg) ; move mid just before bot
 558          (setcdr mid-cell       bot-cell)
 559          (setcdr prev-mid-cell  post-mid-cell)
 560          ;; example follow-up:
 561          ;; new-top-list =
 562          ;; 3 <-- mid-cell
 563          ;; 5 <-- bot-cell
 564          ;; 4 <-- prev-mid-cell
 565          ;; 2 <-- post-mid-cell
 566          ;; 1
 567          (setq new-top-list mid-cell)))
 568        (calc-pop-push-list bot-line new-top-list)))
 569     (calc-cursor-stack-index (1- end-line))))
 570
 571
 572
 573 ;;; Other commands.
 574
 575 ;;;###autoload
 576 (defun calc-num-prefix-name (n)
 577   (cond ((eq n '-) "- ")
 578         ((equal n '(4)) "C-u ")
 579         ((consp n) (format "%d " (car n)))
 580         ((integerp n) (format "%d " n))
 581         (t "")))
 582
 583 ;;;###autoload
 584 (defun calc-missing-key (n)
 585   "This is a placeholder for a command which needs to be loaded from calc-ext.
 586 When this key is used, calc-ext (the Calculator extensions module) will be
 587 loaded and the keystroke automatically re-typed."
 588   (interactive "P")
 589   (require 'calc-ext)
 590   (if (keymapp (key-binding (char-to-string last-command-event)))
 591       (message "%s%c-" (calc-num-prefix-name n) last-command-event))
 592   (calc-unread-command)
 593   (setq prefix-arg n))
 594
 595 ;;;###autoload
 596 (defun calc-shift-Y-prefix-help ()
 597   (interactive)
 598   (require 'calc-ext)
 599   (calc-do-prefix-help calc-Y-help-msgs "other" ?Y))
 600
 601
 602
 603
 604 ;;;###autoload
 605 (defun calcDigit-letter ()
 606   (interactive)
 607   (if (calc-minibuffer-contains "[-+]?\\(1[1-9]\\|[2-9][0-9]\\)#.*")
 608       (progn
 609         (setq last-command-event (upcase last-command-event))
 610         (calcDigit-key))
 611     (calcDigit-nondigit)))
 612
 613
 614 ;; A Lisp version of temp_minibuffer_message from minibuf.c.
 615 ;;;###autoload
 616 (defun calc-temp-minibuffer-message (m)
 617   (let ((savemax (point-max)))
 618     (save-excursion
 619       (goto-char (point-max))
 620       (insert m))
 621     (let ((okay nil))
 622       (unwind-protect
 623           (progn
 624             (sit-for 2)
 625             (identity 1)   ; this forces a call to QUIT; in bytecode.c.
 626             (setq okay t))
 627         (progn
 628           (delete-region savemax (point-max))
 629           (or okay (abort-recursive-edit)))))))
 630
 631
 632 (put 'math-with-extra-prec 'lisp-indent-hook 1)
 633
 634
 635 ;; Concatenate two vectors, or a vector and an object.  [V O O] [Public]
 636 ;;;###autoload
 637 (defun math-concat (v1 v2)
 638   (if (stringp v1)
 639       (concat v1 v2)
 640     (require 'calc-ext)
 641     (if (and (or (math-objvecp v1) (math-known-scalarp v1))
 642              (or (math-objvecp v2) (math-known-scalarp v2)))
 643         (append (if (and (math-vectorp v1)
 644                          (or (math-matrixp v1)
 645                              (not (math-matrixp v2))))
 646                     v1
 647                   (list 'vec v1))
 648                 (if (and (math-vectorp v2)
 649                          (or (math-matrixp v2)
 650                              (not (math-matrixp v1))))
 651                     (cdr v2)
 652                   (list v2)))
 653       (list '| v1 v2))))
 654
 655
 656 ;; True if A is zero.  Works for un-normalized values.  [P n] [Public]
 657 ;;;###autoload
 658 (defun math-zerop (a)
 659   (if (consp a)
 660       (cond ((memq (car a) '(bigpos bigneg))
 661              (while (eq (car (setq a (cdr a))) 0))
 662              (null a))
 663             ((memq (car a) '(frac float polar mod))
 664              (math-zerop (nth 1 a)))
 665             ((eq (car a) 'cplx)
 666              (and (math-zerop (nth 1 a)) (math-zerop (nth 2 a))))
 667             ((eq (car a) 'hms)
 668              (and (math-zerop (nth 1 a))
 669                   (math-zerop (nth 2 a))
 670                   (math-zerop (nth 3 a)))))
 671     (eq a 0)))
 672
 673
 674 ;; True if A is real and negative.  [P n] [Public]
 675
 676 ;;;###autoload
 677 (defun math-negp (a)
 678   (if (consp a)
 679       (cond ((eq (car a) 'bigpos) nil)
 680             ((eq (car a) 'bigneg) (cdr a))
 681             ((memq (car a) '(float frac))
 682              (Math-integer-negp (nth 1 a)))
 683             ((eq (car a) 'hms)
 684              (if (math-zerop (nth 1 a))
 685                  (if (math-zerop (nth 2 a))
 686                      (math-negp (nth 3 a))
 687                    (math-negp (nth 2 a)))
 688                (math-negp (nth 1 a))))
 689             ((eq (car a) 'date)
 690              (math-negp (nth 1 a)))
 691             ((eq (car a) 'intv)
 692              (or (math-negp (nth 3 a))
 693                  (and (math-zerop (nth 3 a))
 694                       (memq (nth 1 a) '(0 2)))))
 695             ((equal a '(neg (var inf var-inf))) t))
 696     (< a 0)))
 697
 698 ;; True if A is a negative number or an expression the starts with '-'.
 699 ;;;###autoload
 700 (defun math-looks-negp (a)   ; [P x] [Public]
 701   (or (Math-negp a)
 702       (eq (car-safe a) 'neg)
 703       (and (memq (car-safe a) '(* /))
 704            (or (math-looks-negp (nth 1 a))
 705                (math-looks-negp (nth 2 a))))
 706       (and (eq (car-safe a) '-)
 707            (math-looks-negp (nth 1 a)))))
 708
 709
 710 ;; True if A is real and positive.  [P n] [Public]
 711 ;;;###autoload
 712 (defun math-posp (a)
 713   (if (consp a)
 714       (cond ((eq (car a) 'bigpos) (cdr a))
 715             ((eq (car a) 'bigneg) nil)
 716             ((memq (car a) '(float frac))
 717              (Math-integer-posp (nth 1 a)))
 718             ((eq (car a) 'hms)
 719              (if (math-zerop (nth 1 a))
 720                  (if (math-zerop (nth 2 a))
 721                      (math-posp (nth 3 a))
 722                    (math-posp (nth 2 a)))
 723                (math-posp (nth 1 a))))
 724             ((eq (car a) 'date)
 725              (math-posp (nth 1 a)))
 726             ((eq (car a) 'mod)
 727              (not (math-zerop (nth 1 a))))
 728             ((eq (car a) 'intv)
 729              (or (math-posp (nth 2 a))
 730                  (and (math-zerop (nth 2 a))
 731                       (memq (nth 1 a) '(0 1)))))
 732             ((equal a '(var inf var-inf)) t))
 733     (> a 0)))
 734
 735 ;;;###autoload
 736 (defalias 'math-fixnump 'integerp)
 737 ;;;###autoload
 738 (defalias 'math-fixnatnump 'natnump)
 739
 740
 741 ;; True if A is an even integer.  [P R R] [Public]
 742 ;;;###autoload
 743 (defun math-evenp (a)
 744   (if (consp a)
 745       (and (memq (car a) '(bigpos bigneg))
 746            (= (% (nth 1 a) 2) 0))
 747     (= (% a 2) 0)))
 748
 749 ;; Compute A / 2, for small or big integer A.  [I i]
 750 ;; If A is negative, type of truncation is undefined.
 751 ;;;###autoload
 752 (defun math-div2 (a)
 753   (if (consp a)
 754       (if (cdr a)
 755           (math-normalize (cons (car a) (math-div2-bignum (cdr a))))
 756         0)
 757     (/ a 2)))
 758
 759 ;;;###autoload
 760 (defun math-div2-bignum (a)   ; [l l]
 761   (if (cdr a)
 762       (cons (+ (/ (car a) 2) (* (% (nth 1 a) 2) (/ math-bignum-digit-size 2)))
 763             (math-div2-bignum (cdr a)))
 764     (list (/ (car a) 2))))
 765
 766
 767 ;; Reject an argument to a calculator function.  [Public]
 768 ;;;###autoload
 769 (defun math-reject-arg (&optional a p option)
 770   (if option
 771       (calc-record-why option p a)
 772     (if p
 773         (calc-record-why p a)))
 774   (signal 'wrong-type-argument (and a (if p (list p a) (list a)))))
 775
 776
 777 ;; Coerce A to be an integer (by truncation toward zero).  [I N] [Public]
 778
 779 ;; The variable math-trunc-prec is local to math-trunc, but used by
 780 ;; math-trunc-fancy in calc-arith.el, which is called by math-trunc.
 781
 782 ;;;###autoload
 783 (defun math-trunc (a &optional math-trunc-prec)
 784   (cond (math-trunc-prec
 785          (require 'calc-ext)
 786          (math-trunc-special a math-trunc-prec))
 787         ((Math-integerp a) a)
 788         ((Math-looks-negp a)
 789          (math-neg (math-trunc (math-neg a))))
 790         ((eq (car a) 'float)
 791          (math-scale-int (nth 1 a) (nth 2 a)))
 792         (t (require 'calc-ext)
 793            (math-trunc-fancy a))))
 794 ;;;###autoload
 795 (defalias 'calcFunc-trunc 'math-trunc)
 796
 797 ;; Coerce A to be an integer (by truncation toward minus infinity).  [I N]
 798
 799 ;; The variable math-floor-prec is local to math-floor, but used by
 800 ;; math-floor-fancy in calc-arith.el, which is called by math-floor.
 801
 802 ;;;###autoload
 803 (defun math-floor (a &optional math-floor-prec)    ;  [Public]
 804   (cond (math-floor-prec
 805          (require 'calc-ext)
 806          (math-floor-special a math-floor-prec))
 807         ((Math-integerp a) a)
 808         ((Math-messy-integerp a) (math-trunc a))
 809         ((Math-realp a)
 810          (if (Math-negp a)
 811              (math-add (math-trunc a) -1)
 812            (math-trunc a)))
 813         (t (require 'calc-ext)
 814            (math-floor-fancy a))))
 815 ;;;###autoload
 816 (defalias 'calcFunc-floor 'math-floor)
 817
 818
 819 ;;;###autoload
 820 (defun math-imod (a b)   ; [I I I] [Public]
 821   (if (and (not (consp a)) (not (consp b)))
 822       (if (= b 0)
 823           (math-reject-arg a "*Division by zero")
 824         (% a b))
 825     (cdr (math-idivmod a b))))
 826
 827
 828 ;;;###autoload
 829 (defun calcFunc-inv (m)
 830   (if (Math-vectorp m)
 831       (progn
 832         (require 'calc-ext)
 833         (if (math-square-matrixp m)
 834             (or (math-with-extra-prec 2 (math-matrix-inv-raw m))
 835                 (math-reject-arg m "*Singular matrix"))
 836           (math-reject-arg m 'square-matrixp)))
 837     (if (and
 838          (require 'calc-arith)
 839          (math-known-matrixp m))
 840         (math-pow m -1)
 841       (math-div 1 m))))
 842
 843 ;;;###autoload
 844 (defun math-do-working (msg arg)
 845   (or executing-kbd-macro
 846       (progn
 847         (calc-set-command-flag 'clear-message)
 848         (if math-working-step
 849             (if math-working-step-2
 850                 (setq msg (format "[%d/%d] %s"
 851                                   math-working-step math-working-step-2 msg))
 852               (setq msg (format "[%d] %s" math-working-step msg))))
 853         (message "Working... %s = %s" msg
 854                  (math-showing-full-precision (math-format-number arg))))))
 855
 856
 857 ;; Compute A modulo B, defined in terms of truncation toward minus infinity.
 858 ;;;###autoload
 859 (defun math-mod (a b)   ; [R R R] [Public]
 860   (cond ((and (Math-zerop a) (not (eq (car-safe a) 'mod))) a)
 861         ((Math-zerop b)
 862          (math-reject-arg a "*Division by zero"))
 863         ((and (Math-natnump a) (Math-natnump b))
 864          (math-imod a b))
 865         ((and (Math-anglep a) (Math-anglep b))
 866          (math-sub a (math-mul (math-floor (math-div a b)) b)))
 867         (t (require 'calc-ext)
 868            (math-mod-fancy a b))))
 869
 870
 871
 872 ;;; General exponentiation.
 873
 874 ;;;###autoload
 875 (defun math-pow (a b)   ; [O O N] [Public]
 876   (cond ((equal b '(var nan var-nan))
 877          b)
 878         ((Math-zerop a)
 879          (if (and (Math-scalarp b) (Math-posp b))
 880              (if (math-floatp b) (math-float a) a)
 881            (require 'calc-ext)
 882            (math-pow-of-zero a b)))
 883         ((or (eq a 1) (eq b 1)) a)
 884         ((or (equal a '(float 1 0)) (equal b '(float 1 0))) a)
 885         ((Math-zerop b)
 886          (if (Math-scalarp a)
 887              (if (or (math-floatp a) (math-floatp b))
 888                  '(float 1 0) 1)
 889            (require 'calc-ext)
 890            (math-pow-zero a b)))
 891         ((and (Math-integerp b) (or (Math-numberp a) (Math-vectorp a)))
 892          (if (and (equal a '(float 1 1)) (integerp b))
 893              (math-make-float 1 b)
 894            (math-with-extra-prec 2
 895              (math-ipow a b))))
 896         (t
 897          (require 'calc-ext)
 898          (math-pow-fancy a b))))
 899
 900 ;;;###autoload
 901 (defun math-ipow (a n)   ; [O O I] [Public]
 902   (cond ((Math-integer-negp n)
 903          (math-ipow (math-div 1 a) (Math-integer-neg n)))
 904         ((not (consp n))
 905          (if (and (Math-ratp a) (> n 20))
 906              (math-iipow-show a n)
 907            (math-iipow a n)))
 908         ((math-evenp n)
 909          (math-ipow (math-mul a a) (math-div2 n)))
 910         (t
 911          (math-mul a (math-ipow (math-mul a a)
 912                                 (math-div2 (math-add n -1)))))))
 913
 914 (defun math-iipow (a n)   ; [O O S]
 915   (cond ((= n 0) 1)
 916         ((= n 1) a)
 917         ((= (% n 2) 0) (math-iipow (math-mul a a) (/ n 2)))
 918         (t (math-mul a (math-iipow (math-mul a a) (/ n 2))))))
 919
 920 (defun math-iipow-show (a n)   ; [O O S]
 921   (math-working "pow" a)
 922   (let ((val (cond
 923               ((= n 0) 1)
 924               ((= n 1) a)
 925               ((= (% n 2) 0) (math-iipow-show (math-mul a a) (/ n 2)))
 926               (t (math-mul a (math-iipow-show (math-mul a a) (/ n 2)))))))
 927     (math-working "pow" val)
 928     val))
 929
 930
 931 ;;;###autoload
 932 (defun math-read-radix-digit (dig)   ; [D S; Z S]
 933   (if (> dig ?9)
 934       (if (< dig ?A)
 935           nil
 936         (- dig 55))
 937     (if (>= dig ?0)
 938         (- dig ?0)
 939       nil)))
 940
 941
 942 ;;; Bug reporting
 943
 944 ;;;###autoload
 945 (defun report-calc-bug ()
 946   "Report a bug in Calc, the GNU Emacs calculator.
 947 Prompts for bug subject.  Leaves you in a mail buffer."
 948   (interactive)
 949   (let ((reporter-prompt-for-summary-p t))
 950     (reporter-submit-bug-report calc-bug-address "Calc"
 951                                 nil nil nil
 952                                 "Please describe exactly what actions triggered the bug and the
 953 precise symptoms of the bug.  If possible, include a backtrace by
 954 doing 'M-x toggle-debug-on-error', then reproducing the bug.
 955 " )))
 956 ;;;###autoload
 957 (defalias 'calc-report-bug 'report-calc-bug)
 958
 959 (provide 'calc-misc)
 960
 961 ;; Local variables:
 962 ;; generated-autoload-file: "calc-loaddefs.el"
 963 ;; End:
 964
 965 ;;; calc-misc.el ends here