1 ;;; calc-mode.el --- calculator modes for Calc
3 ;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
5 ;; Author: David Gillespie <daveg@synaptics.com>
6 ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
8 ;; 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 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
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.
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/>.
27 ;; This file is autoloaded from calc-ext.el.
32 ;; Declare functions which are defined elsewhere.
33 (declare-function calc-embedded-save-original-modes
"calc-embed" ())
36 (defun calc-line-numbering (n)
39 (message (if (calc-change-mode 'calc-line-numbering n t t
)
40 "Displaying stack level numbers"
41 "Hiding stack level numbers"))))
43 (defun calc-line-breaking (n)
47 (and (> (setq n
(prefix-numeric-value n
)) 0)
50 (not calc-line-breaking
)))
51 (if (calc-change-mode 'calc-line-breaking n t
)
52 (if (integerp calc-line-breaking
)
53 (message "Breaking lines longer than %d characters" n
)
54 (message "Breaking long lines in Stack display"))
55 (message "Not breaking long lines in Stack display"))))
58 (defun calc-left-justify (n)
61 (and n
(setq n
(prefix-numeric-value n
)))
62 (calc-change-mode '(calc-display-just calc-display-origin
)
65 (message "Displaying stack entries indented by %d" n
)
66 (message "Displaying stack entries left-justified"))))
68 (defun calc-center-justify (n)
71 (and n
(setq n
(prefix-numeric-value n
)))
72 (calc-change-mode '(calc-display-just calc-display-origin
)
75 (message "Displaying stack entries centered on column %d" n
)
76 (message "Displaying stack entries centered in window"))))
78 (defun calc-right-justify (n)
81 (and n
(setq n
(prefix-numeric-value n
)))
82 (calc-change-mode '(calc-display-just calc-display-origin
)
85 (message "Displaying stack entries right-justified to column %d" n
)
86 (message "Displaying stack entries right-justified in window"))))
88 (defun calc-left-label (s)
89 (interactive "sLefthand label: ")
92 (setq s
(concat s
" ")))
93 (calc-change-mode 'calc-left-label s t
)))
95 (defun calc-right-label (s)
96 (interactive "sRighthand label: ")
99 (setq s
(concat " " s
)))
100 (calc-change-mode 'calc-right-label s t
)))
102 (defun calc-auto-why (n)
107 (setq n
(prefix-numeric-value n
))
108 (if (<= n
0) (setq n nil
)
109 (if (> n
1) (setq n t
))))
110 (setq n
(and (not (eq calc-auto-why t
)) (if calc-auto-why t
1))))
111 (calc-change-mode 'calc-auto-why n nil
)
113 (message "User must press ‘w’ to explain unsimplified results"))
115 (message "Automatically doing ‘w’ to explain unsimplified results"))
117 (message "Automatically doing ‘w’ only for unusual messages")))))
119 (defun calc-group-digits (n)
124 (setq n
(prefix-numeric-value n
))
125 (cond ((or (> n
0) (< n -
1)))
129 (setq n calc-group-digits
))))
130 (setq n
(not calc-group-digits
)))
131 (calc-change-mode 'calc-group-digits n t
)
133 (message "Grouping is off"))
135 (message "Grouping every %d digits" (math-abs n
)))
137 (message "Grouping is on")))))
139 (defun calc-group-char (ch)
140 (interactive "cGrouping character: ")
143 (error "Control characters not allowed for grouping"))
146 (setq ch
(char-to-string ch
)))
147 (calc-change-mode 'calc-group-char ch calc-group-digits
)
148 (message "Digit grouping character is \"%s\"" ch
)))
150 (defun calc-point-char (ch)
151 (interactive "cCharacter to use as decimal point: ")
154 (error "Control characters not allowed as decimal point"))
155 (calc-change-mode 'calc-point-char
(char-to-string ch
) t
)
156 (message "Decimal point character is \"%c\"" ch
)))
158 (defun calc-normal-notation (n)
161 (calc-change-mode 'calc-float-format
162 (let* ((val (if n
(prefix-numeric-value n
) 0))
163 (mode (/ (+ val
5000) 10000)))
164 (if (or (< val -
5000) (> mode
3))
165 (error "Prefix out of range"))
166 (setq n
(list (aref [float sci eng fix
] mode
)
167 (- (%
(+ val
5000) 10000) 5000))))
170 (message "Displaying floating-point numbers normally")
173 "Displaying floating-point numbers with %d significant digits"
175 (message "Displaying floating-point numbers with (precision%d)"
178 (defun calc-fix-notation (n)
179 (interactive "NDigits after decimal point: ")
181 (calc-change-mode 'calc-float-format
182 (setq n
(list 'fix
(if n
(prefix-numeric-value n
) 0)))
184 (message "Displaying floats with %d digits after decimal"
185 (math-abs (nth 1 n
)))))
187 (defun calc-sci-notation (n)
190 (calc-change-mode 'calc-float-format
191 (setq n
(list 'sci
(if n
(prefix-numeric-value n
) 0)))
194 (message "Displaying floats in scientific notation")
196 (message "Displaying scientific notation with %d significant digits"
198 (message "Displaying scientific notation with (precision%d)"
201 (defun calc-eng-notation (n)
204 (calc-change-mode 'calc-float-format
205 (setq n
(list 'eng
(if n
(prefix-numeric-value n
) 0)))
208 (message "Displaying floats in engineering notation")
210 (message "Displaying engineering notation with %d significant digits"
212 (message "Displaying engineering notation with (precision%d)"
216 (defun calc-truncate-stack (n &optional rel
)
219 (let ((oldtop calc-stack-top
)
220 (newtop calc-stack-top
))
221 (calc-record-undo (list 'set
'saved-stack-top calc-stack-top
))
222 (let ((calc-stack-top 0)
223 (nn (prefix-numeric-value n
)))
228 (setq nn
(+ oldtop nn
))
230 (setq nn
(+ nn
(calc-stack-size)))
234 (if (> nn
(calc-stack-size))
237 (max 1 (calc-locate-cursor-element (point)))))
238 (if (= newtop oldtop
)
240 (calc-pop-stack 1 oldtop t
)
241 (calc-push-list '(top-of-stack) newtop
)
242 (if calc-line-numbering
244 (calc-record-undo (list 'set
'saved-stack-top
0))
245 (setq calc-stack-top newtop
))))
247 (defun calc-truncate-up (n)
249 (calc-truncate-stack n t
))
251 (defun calc-truncate-down (n)
253 (calc-truncate-stack (- n
) t
))
255 (defun calc-display-raw (arg)
258 (setq calc-display-raw
(if calc-display-raw nil
(if arg
0 t
)))
261 (message "%s" "Press d ' again to cancel \"raw\" display mode"))))
268 (defun calc-save-modes ()
272 (vals (mapcar (function (lambda (v) (symbol-value (car v
))))
273 calc-mode-var-list
)))
274 (unless calc-settings-file
275 (error "No ‘calc-settings-file’ specified"))
276 (set-buffer (find-file-noselect (substitute-in-file-name
277 calc-settings-file
)))
278 (goto-char (point-min))
279 (if (and (search-forward ";;; Mode settings stored by Calc" nil t
)
283 (search-forward "\n;;; End of mode settings" nil t
)))
287 (delete-region pos
(point)))
288 (goto-char (point-max))
291 (insert ";;; Mode settings stored by Calc on " (current-time-string) "\n")
292 (let ((list calc-mode-var-list
))
294 (let* ((v (car (car list
)))
295 (def (nth 1 (car list
)))
299 (insert "(setq " (symbol-name v
) " ")
300 (if (and (or (listp val
)
302 (not (memq val
'(nil t
))))
304 (insert (prin1-to-string val
) ")\n"))))
305 (setq list
(cdr list
)
307 (run-hooks 'calc-mode-save-hook
)
308 (insert ";;; End of mode settings\n")
310 (if calc-embedded-info
311 (calc-embedded-save-original-modes)))))
313 (defun calc-settings-file-name (name &optional arg
)
315 (list (read-file-name (format "Settings file name (normally %s): "
316 (abbreviate-file-name calc-settings-file
)))
319 (setq arg
(if arg
(prefix-numeric-value arg
) 0))
320 (if (string-equal (file-name-nondirectory name
) "")
321 (message "Calc settings file is \"%s\"" calc-settings-file
)
322 (if (< (math-abs arg
) 2)
323 (let ((list calc-mode-var-list
))
325 (set (car (car list
)) (nth 1 (car list
)))
326 (setq list
(cdr list
)))))
327 (setq calc-settings-file name
)
330 (equal user-init-file calc-settings-file
)
334 (message "New file")))))
336 (defun math-get-modes-vec ()
342 (+ (if (<= (nth 1 calc-float-format
) 0)
343 (+ calc-internal-prec
(nth 1 calc-float-format
))
344 (nth 1 calc-float-format
))
345 (cdr (assq (car calc-float-format
)
346 '((float .
0) (sci .
10000)
347 (eng .
20000) (fix .
30000)))))
348 (cond ((eq calc-angle-mode
'rad
) 2)
349 ((eq calc-angle-mode
'hms
) 3)
351 (if calc-symbolic-mode
1 0)
352 (if calc-prefer-frac
1 0)
353 (if (eq calc-complex-mode
'polar
) 1 0)
354 (cond ((eq calc-matrix-mode
'scalar
) 0)
355 ((eq calc-matrix-mode
'matrix
) -
2)
356 ((eq calc-matrix-mode
'sqmatrix
) -
3)
359 (cond ((eq calc-simplify-mode
'none
) -
1)
360 ((eq calc-simplify-mode
'num
) 0)
361 ((eq calc-simplify-mode
'binary
) 2)
362 ((eq calc-simplify-mode
'alg
) 3)
363 ((eq calc-simplify-mode
'ext
) 4)
364 ((eq calc-simplify-mode
'units
) 5)
366 (cond ((eq calc-infinite-mode
1) 0)
367 (calc-infinite-mode 1)
370 (defun calc-get-modes (n)
373 (let ((modes (math-get-modes-vec)))
374 (calc-enter-result 0 "mode"
376 (if (and (>= (setq n
(prefix-numeric-value n
)) 1)
377 (< n
(length modes
)))
379 (error "Prefix out of range"))
382 (defun calc-shift-prefix (arg)
385 (setq calc-shift-prefix
(if arg
386 (> (prefix-numeric-value arg
) 0)
387 (not calc-shift-prefix
)))
389 (message (if calc-shift-prefix
390 "Prefix keys are now case-insensitive"
391 "Prefix keys must be unshifted (except V, Z)"))))
393 (defun calc-mode-record-mode (n)
396 (calc-change-mode 'calc-mode-save-mode
398 (cond ((not calc-embedded-info
)
399 (if (eq calc-mode-save-mode
'save
)
401 ((eq calc-mode-save-mode
'local
) 'edit
)
402 ((eq calc-mode-save-mode
'edit
) 'perm
)
403 ((eq calc-mode-save-mode
'perm
) 'global
)
404 ((eq calc-mode-save-mode
'global
) 'save
)
405 ((eq calc-mode-save-mode
'save
) nil
)
406 ((eq calc-mode-save-mode nil
) 'local
)))
407 ((= (setq n
(prefix-numeric-value n
)) 0) nil
)
414 (cond ((and (eq calc-mode-save-mode
'local
) calc-embedded-info
)
415 "Recording mode changes with [calc-mode: ...]")
416 ((eq calc-mode-save-mode
'edit
)
417 "Recording mode changes with [calc-edit-mode: ...]")
418 ((eq calc-mode-save-mode
'perm
)
419 "Recording mode changes with [calc-perm-mode: ...]")
420 ((eq calc-mode-save-mode
'global
)
421 "Recording mode changes with [calc-global-mode: ...]")
422 ((eq calc-mode-save-mode
'save
)
423 (format "Recording mode changes in \"%s\""
426 "Not recording mode changes permanently")))))
428 (defun calc-total-algebraic-mode (flag)
431 (if (eq calc-algebraic-mode
'total
)
432 (calc-algebraic-mode nil
)
433 (calc-change-mode '(calc-algebraic-mode calc-incomplete-algebraic-mode
)
435 (use-local-map calc-alg-map
)
437 "All keys begin algebraic entry; use Meta (ESC) for Calc keys"))))
439 (defun calc-algebraic-mode (flag)
443 (calc-change-mode '(calc-algebraic-mode
444 calc-incomplete-algebraic-mode
)
445 (list nil
(not calc-incomplete-algebraic-mode
)))
446 (calc-change-mode '(calc-algebraic-mode calc-incomplete-algebraic-mode
)
447 (list (not calc-algebraic-mode
) nil
)))
448 (use-local-map calc-mode-map
)
449 (message "%s" (if calc-algebraic-mode
450 "Numeric keys and ( and [ begin algebraic entry"
451 (if calc-incomplete-algebraic-mode
452 "Only ( and [ begin algebraic entry"
453 "No keys except ' and $ begin algebraic entry")))))
455 (defun calc-symbolic-mode (n)
459 (message (if (calc-change-mode 'calc-symbolic-mode n nil t
)
460 "Inexact computations like sqrt(2) are deferred"
461 "Numerical computations are always done immediately"))))
463 (defun calc-infinite-mode (n)
468 (calc-change-mode 'calc-infinite-mode
1)
469 (message "Computations like 1 / 0 produce \"inf\""))
470 (message (if (calc-change-mode 'calc-infinite-mode n nil t
)
471 "Computations like 1 / 0 produce \"uinf\""
472 "Computations like 1 / 0 are left unsimplified")))))
474 (defun calc-matrix-mode (arg)
477 (calc-change-mode 'calc-matrix-mode
478 (cond ((eq arg
0) 'scalar
)
479 ((< (prefix-numeric-value arg
) 1)
480 (and (< (prefix-numeric-value arg
) -
1) 'matrix
))
482 (if (consp arg
) 'sqmatrix
483 (prefix-numeric-value arg
)))
484 ((eq calc-matrix-mode
'matrix
) 'scalar
)
485 ((eq calc-matrix-mode
'scalar
) nil
)
487 (if (integerp calc-matrix-mode
)
488 (message "Variables are assumed to be %dx%d matrices"
489 calc-matrix-mode calc-matrix-mode
)
490 (message (if (eq calc-matrix-mode
'matrix
)
491 "Variables are assumed to be matrices"
492 (if (eq calc-matrix-mode
'sqmatrix
)
493 "Variables are assumed to be square matrices"
495 "Variables are assumed to be scalars (non-matrices)"
496 "Variables are not assumed to be matrix or scalar")))))))
498 (defun calc-set-simplify-mode (mode arg msg
)
499 (calc-change-mode 'calc-simplify-mode
502 ((eq calc-simplify-mode mode
)
505 (message "%s" (if (eq calc-simplify-mode mode
)
507 "Algebraic simplification occurs by default")))
509 (defun calc-no-simplify-mode (arg)
512 (calc-set-simplify-mode 'none arg
513 "Simplification is disabled")))
515 (defun calc-num-simplify-mode (arg)
518 (calc-set-simplify-mode 'num arg
519 "Basic simplifications apply only if arguments are numeric")))
521 (defun calc-default-simplify-mode (arg)
523 (cond ((or (not arg
) (= arg
3))
525 (calc-set-simplify-mode
526 'alg nil
"Algebraic simplification occurs by default")))
529 (calc-set-simplify-mode
530 nil nil
"Only basic simplifications occur by default")))
531 ((= arg
0) (calc-num-simplify-mode 1))
532 ((< arg
0) (calc-no-simplify-mode 1))
533 ((= arg
2) (calc-bin-simplify-mode 1))
534 ((= arg
4) (calc-ext-simplify-mode 1))
535 ((= arg
5) (calc-units-simplify-mode 1))
536 (t (error "Prefix argument out of range"))))
538 (defun calc-bin-simplify-mode (arg)
541 (calc-set-simplify-mode 'binary arg
542 (format "Binary simplification occurs by default (word size=%d)"
545 (defun calc-basic-simplify-mode (arg)
548 (calc-set-simplify-mode nil arg
549 "Only basic simplifications occur by default")))
551 (defun calc-alg-simplify-mode (arg)
554 (calc-set-simplify-mode 'alg arg
555 "Algebraic simplification occurs by default")))
557 (defun calc-ext-simplify-mode (arg)
560 (calc-set-simplify-mode 'ext arg
561 "Extended algebraic simplification occurs by default")))
563 (defun calc-units-simplify-mode (arg)
566 (calc-set-simplify-mode 'units arg
567 "Units simplification occurs by default")))
569 (defun calc-auto-recompute (arg)
572 (calc-change-mode 'calc-auto-recompute arg nil t
)
573 (calc-refresh-evaltos)
574 (message (if calc-auto-recompute
575 "Automatically recomputing ‘=>’ forms when necessary"
576 "Not recomputing ‘=>’ forms automatically"))))
578 (defun calc-working (n)
582 (calc-pop-push-record 0 "work"
583 (cond ((eq calc-display-working-message t
) 1)
584 (calc-display-working-message 2)
586 ((eq n
2) (calc-change-mode 'calc-display-working-message
'lots
))
587 ((eq n
0) (calc-change-mode 'calc-display-working-message nil
))
588 ((eq n
1) (calc-change-mode 'calc-display-working-message t
)))
589 (cond ((eq calc-display-working-message t
)
590 (message "\"Working...\" messages enabled"))
591 (calc-display-working-message
592 (message "Detailed \"Working...\" messages enabled"))
594 (message "\"Working...\" messages disabled")))))
596 (defun calc-always-load-extensions ()
599 (if (setq calc-always-load-extensions
(not calc-always-load-extensions
))
600 (message "Always loading extensions package")
601 (message "Loading extensions package on demand only"))))
604 (defun calc-matrix-left-justify ()
607 (calc-change-mode 'calc-matrix-just nil t
)
608 (message "Matrix elements will be left-justified in columns")))
610 (defun calc-matrix-center-justify ()
613 (calc-change-mode 'calc-matrix-just
'center t
)
614 (message "Matrix elements will be centered in columns")))
616 (defun calc-matrix-right-justify ()
619 (calc-change-mode 'calc-matrix-just
'right t
)
620 (message "Matrix elements will be right-justified in columns")))
622 (defun calc-full-vectors (n)
625 (message (if (calc-change-mode 'calc-full-vectors n t t
)
626 "Displaying long vectors in full"
627 "Displaying long vectors in [a, b, c, ..., z] notation"))))
629 (defun calc-full-trail-vectors (n)
632 (message (if (calc-change-mode 'calc-full-trail-vectors n nil t
)
633 "Recording long vectors in full"
634 "Recording long vectors in [a, b, c, ..., z] notation"))))
636 (defun calc-break-vectors (n)
639 (message (if (calc-change-mode 'calc-break-vectors n t t
)
640 "Displaying vector elements one-per-line"
641 "Displaying vector elements all on one line"))))
643 (defun calc-vector-commas ()
646 (if (calc-change-mode 'calc-vector-commas
(if calc-vector-commas nil
",") t
)
647 (message "Separating vector elements with \",\"")
648 (message "Separating vector elements with spaces"))))
650 (defun calc-vector-brackets ()
653 (if (calc-change-mode 'calc-vector-brackets
654 (if (equal calc-vector-brackets
"[]") nil
"[]") t
)
655 (message "Surrounding vectors with \"[]\"")
656 (message "Not surrounding vectors with brackets"))))
658 (defun calc-vector-braces ()
661 (if (calc-change-mode 'calc-vector-brackets
662 (if (equal calc-vector-brackets
"{}") nil
"{}") t
)
663 (message "Surrounding vectors with \"{}\"")
664 (message "Not surrounding vectors with brackets"))))
666 (defun calc-vector-parens ()
669 (if (calc-change-mode 'calc-vector-brackets
670 (if (equal calc-vector-brackets
"()") nil
"()") t
)
671 (message "Surrounding vectors with \"()\"")
672 (message "Not surrounding vectors with brackets"))))
674 (defun calc-matrix-brackets (arg)
675 (interactive "sCode letters (R, O, C): ")
677 (let ((code (append (and (string-match "[rR]" arg
) '(R))
678 (and (string-match "[oO]" arg
) '(O))
679 (and (string-match "[cC]" arg
) '(C))
680 (and (string-match "[pP]" arg
) '(P))))
681 (bad (string-match "[^rRoOcCpP ]" arg
)))
683 (error "Unrecognized character: %c" (aref arg bad
)))
684 (calc-change-mode 'calc-matrix-brackets code t
))))
688 ;;; calc-mode.el ends here