lisp/calc/calc-misc.el

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