Mercurial > emacs
annotate lisp/calculator.el @ 110410:f2e111723c3a
Merge changes made in Gnus trunk.
Reimplement nnimap, and do tweaks to the rest of the code to support that.
* gnus-int.el (gnus-finish-retrieve-group-infos)
(gnus-retrieve-group-data-early): New functions.
* gnus-range.el (gnus-range-nconcat): New function.
* gnus-start.el (gnus-get-unread-articles): Support early retrieval of
data.
(gnus-read-active-for-groups): Support finishing the early retrieval of
data.
* gnus-sum.el (gnus-summary-move-article): Pass the move-to group name
if the move is internal, so that nnimap can do fast internal moves.
* gnus.el (gnus-article-special-mark-lists): Add uid/active tuples, for
nnimap usage.
* nnimap.el: Rewritten.
* nnmail.el (nnmail-inhibit-default-split-group): New internal variable
to allow the mail splitting to not return a default group. This is
useful for nnimap, which will leave unmatched mail in the inbox.
* utf7.el (utf7-encode): Autoload.
Implement shell connection.
* nnimap.el (nnimap-open-shell-stream): New function.
(nnimap-open-connection): Use it.
Get the number of lines by using BODYSTRUCTURE.
(nnimap-transform-headers): Get the number of lines in each message.
(nnimap-retrieve-headers): Query for BODYSTRUCTURE so that we get the
number of lines.
Not all servers return UIDNEXT. Work past this problem.
Remove junk from end of file.
Fix typo in "bogus" section.
Make capabilties be case-insensitive.
Require cl when compiling.
Don't bug out if the LIST command doesn't have any parameters.
2010-09-17 Knut Anders Hatlen <kahatlen@gmail.com> (tiny change)
* nnimap.el (nnimap-get-groups): Don't bug out if the LIST command
doesn't have any parameters.
(mm-text-html-renderer): Document gnus-article-html.
2010-09-17 Julien Danjou <julien@danjou.info> (tiny fix)
* mm-decode.el (mm-text-html-renderer): Document gnus-article-html.
* dgnushack.el: Define netrc-credentials.
If the user doesn't have a /etc/services, supply some sensible port defaults.
Have `unseen-or-unread' select an unread unseen article first.
(nntp-open-server): Return whether the open was successful or not.
Throughout all files, replace (save-excursion (set-buffer ...)) with (with-current-buffer ... ).
Save result so that it doesn't say "failed" all the time.
Add ~/.authinfo to the default, since that's probably most useful for users.
Don't use the "finish" method when we're reading from the agent.
Add some more nnimap-relevant agent stuff to nnagent.el.
* nnimap.el (nnimap-with-process-buffer): Removed.
Revert one line that was changed by mistake in the last checkin.
(nnimap-open-connection): Don't error out when we can't make a connection
nnimap-related changes to avoid bugging out if we can't contact a server.
* gnus-start.el (gnus-get-unread-articles): Don't try to scan groups
from methods that are denied.
* nnimap.el (nnimap-possibly-change-group): Return nil if we can't log
in.
(nnimap-finish-retrieve-group-infos): Make sure we're not waiting for
nothing.
* gnus-sum.el (gnus-select-newsgroup): Indent.
author | Katsumi Yamaoka <yamaoka@jpl.org> |
---|---|
date | Sat, 18 Sep 2010 10:02:19 +0000 |
parents | 904ccd8f2acb |
children | b799d38f522a |
rev | line source |
---|---|
38436
b174db545cfd
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
35314
diff
changeset
|
1 ;;; calculator.el --- a [not so] simple calculator for Emacs |
27587 | 2 |
94680
5af369a095b7
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94391
diff
changeset
|
3 ;; Copyright (C) 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, |
106815 | 4 ;; 2008, 2009, 2010 Free Software Foundation, Inc. |
27587 | 5 |
35314 | 6 ;; Author: Eli Barzilay <eli@barzilay.org> |
27587 | 7 ;; Keywords: tools, convenience |
8 | |
9 ;; This file is part of GNU Emacs. | |
10 | |
94680
5af369a095b7
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94391
diff
changeset
|
11 ;; GNU Emacs is free software: you can redistribute it and/or modify |
5af369a095b7
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94391
diff
changeset
|
12 ;; it under the terms of the GNU General Public License as published by |
5af369a095b7
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94391
diff
changeset
|
13 ;; the Free Software Foundation, either version 3 of the License, or |
5af369a095b7
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94391
diff
changeset
|
14 ;; (at your option) any later version. |
27587 | 15 |
94680
5af369a095b7
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94391
diff
changeset
|
16 ;; GNU Emacs is distributed in the hope that it will be useful, |
5af369a095b7
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94391
diff
changeset
|
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
5af369a095b7
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94391
diff
changeset
|
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
5af369a095b7
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94391
diff
changeset
|
19 ;; GNU General Public License for more details. |
27587 | 20 |
21 ;; You should have received a copy of the GNU General Public License | |
94680
5af369a095b7
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94391
diff
changeset
|
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
27587 | 23 |
33631 | 24 ;;;===================================================================== |
27587 | 25 ;;; Commentary: |
26 ;; | |
33491 | 27 ;; A calculator for Emacs. |
33551 | 28 ;; Why should you reach for your mouse to get xcalc (calc.exe, gcalc or |
33491 | 29 ;; whatever), when you have Emacs running already? |
27587 | 30 ;; |
31 ;; If this is not part of your Emacs distribution, then simply bind | |
32 ;; `calculator' to a key and make it an autoloaded function, e.g.: | |
33 ;; (autoload 'calculator "calculator" | |
33491 | 34 ;; "Run the Emacs calculator." t) |
27587 | 35 ;; (global-set-key [(control return)] 'calculator) |
36 ;; | |
33491 | 37 ;; Written by Eli Barzilay: Maze is Life! eli@barzilay.org |
38 ;; http://www.barzilay.org/ | |
27587 | 39 ;; |
40 ;; For latest version, check | |
33491 | 41 ;; http://www.barzilay.org/misc/calculator.el |
39430
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
42 ;; |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
43 |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
44 ;;; History: |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
45 ;; I hate history. |
27587 | 46 |
83794
4f498b7dbb7f
Require cl for compilation.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
82140
diff
changeset
|
47 (eval-when-compile (require 'cl)) |
27587 | 48 |
33631 | 49 ;;;===================================================================== |
27587 | 50 ;;; Customization: |
51 | |
52 (defgroup calculator nil | |
33491 | 53 "Simple Emacs calculator." |
27587 | 54 :prefix "calculator" |
30889 | 55 :version "21.1" |
27587 | 56 :group 'tools |
107378
904ccd8f2acb
Reorganize Custom groups.
Chong Yidong <cyd@stupidchicken.com>
parents:
107342
diff
changeset
|
57 :group 'applications) |
27587 | 58 |
59 (defcustom calculator-electric-mode nil | |
100171 | 60 "Run `calculator' electrically, in the echo area. |
33491 | 61 Electric mode saves some place but changes the way you interact with the |
62 calculator." | |
27587 | 63 :type 'boolean |
64 :group 'calculator) | |
65 | |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
66 (defcustom calculator-use-menu t |
100171 | 67 "Make `calculator' create a menu. |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
68 Note that this requires easymenu. Must be set before loading." |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
69 :type 'boolean |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
70 :group 'calculator) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
71 |
27587 | 72 (defcustom calculator-bind-escape nil |
100171 | 73 "If non-nil, set escape to exit the calculator." |
27587 | 74 :type 'boolean |
75 :group 'calculator) | |
76 | |
77 (defcustom calculator-unary-style 'postfix | |
100171 | 78 "Value is either 'prefix or 'postfix. |
27587 | 79 This determines the default behavior of unary operators." |
80 :type '(choice (const prefix) (const postfix)) | |
81 :group 'calculator) | |
82 | |
33491 | 83 (defcustom calculator-prompt "Calc=%s> " |
100171 | 84 "The prompt used by the Emacs calculator. |
75773
8344ba1076b6
(calculator-mode-map): Fix typo in menu entry.
Juanma Barranquero <lekktu@gmail.com>
parents:
75762
diff
changeset
|
85 It should contain a \"%s\" somewhere that will indicate the i/o radixes; |
8344ba1076b6
(calculator-mode-map): Fix typo in menu entry.
Juanma Barranquero <lekktu@gmail.com>
parents:
75762
diff
changeset
|
86 this will be a two-character string as described in the documentation |
8344ba1076b6
(calculator-mode-map): Fix typo in menu entry.
Juanma Barranquero <lekktu@gmail.com>
parents:
75762
diff
changeset
|
87 for `calculator-mode'." |
27587 | 88 :type 'string |
89 :group 'calculator) | |
90 | |
33491 | 91 (defcustom calculator-number-digits 3 |
100171 | 92 "The calculator's number of digits used for standard display. |
33491 | 93 Used by the `calculator-standard-display' function - it will use the |
94 format string \"%.NC\" where this number is N and C is a character given | |
95 at runtime." | |
35214
668b2bcf528a
(calculator-number-digits): Fix :type.
Dave Love <fx@gnu.org>
parents:
33631
diff
changeset
|
96 :type 'integer |
27587 | 97 :group 'calculator) |
98 | |
59056
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
99 (defcustom calculator-radix-grouping-mode t |
100171 | 100 "Use digit grouping in radix output mode. |
59056
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
101 If this is set, chunks of `calculator-radix-grouping-digits' characters |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
102 will be separated by `calculator-radix-grouping-separator' when in radix |
62531
c905fcf5e3d9
Specify missing group (and type, if simple) in defcustom.
Juanma Barranquero <lekktu@gmail.com>
parents:
59056
diff
changeset
|
103 output mode is active (determined by `calculator-output-radix')." |
c905fcf5e3d9
Specify missing group (and type, if simple) in defcustom.
Juanma Barranquero <lekktu@gmail.com>
parents:
59056
diff
changeset
|
104 :type 'boolean |
c905fcf5e3d9
Specify missing group (and type, if simple) in defcustom.
Juanma Barranquero <lekktu@gmail.com>
parents:
59056
diff
changeset
|
105 :group 'calculator) |
59056
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
106 |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
107 (defcustom calculator-radix-grouping-digits 4 |
100171 | 108 "The number of digits used for grouping display in radix modes. |
62531
c905fcf5e3d9
Specify missing group (and type, if simple) in defcustom.
Juanma Barranquero <lekktu@gmail.com>
parents:
59056
diff
changeset
|
109 See `calculator-radix-grouping-mode'." |
c905fcf5e3d9
Specify missing group (and type, if simple) in defcustom.
Juanma Barranquero <lekktu@gmail.com>
parents:
59056
diff
changeset
|
110 :type 'integer |
c905fcf5e3d9
Specify missing group (and type, if simple) in defcustom.
Juanma Barranquero <lekktu@gmail.com>
parents:
59056
diff
changeset
|
111 :group 'calculator) |
59056
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
112 |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
113 (defcustom calculator-radix-grouping-separator "'" |
100171 | 114 "The separator used in radix grouping display. |
62531
c905fcf5e3d9
Specify missing group (and type, if simple) in defcustom.
Juanma Barranquero <lekktu@gmail.com>
parents:
59056
diff
changeset
|
115 See `calculator-radix-grouping-mode'." |
c905fcf5e3d9
Specify missing group (and type, if simple) in defcustom.
Juanma Barranquero <lekktu@gmail.com>
parents:
59056
diff
changeset
|
116 :type 'string |
c905fcf5e3d9
Specify missing group (and type, if simple) in defcustom.
Juanma Barranquero <lekktu@gmail.com>
parents:
59056
diff
changeset
|
117 :group 'calculator) |
59056
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
118 |
33491 | 119 (defcustom calculator-remove-zeros t |
100171 | 120 "Non-nil value means delete all redundant zero decimal digits. |
33491 | 121 If this value is not t, and not nil, redundant zeros are removed except |
122 for one and if it is nil, nothing is removed. | |
123 Used by the `calculator-remove-zeros' function." | |
124 :type '(choice (const t) (const leave-decimal) (const nil)) | |
27587 | 125 :group 'calculator) |
126 | |
33491 | 127 (defcustom calculator-displayer '(std ?n) |
100171 | 128 "A displayer specification for numerical values. |
33491 | 129 This is the displayer used to show all numbers in an expression. Result |
130 values will be displayed according to the first element of | |
131 `calculator-displayers'. | |
132 | |
133 The displayer is a symbol, a string or an expression. A symbol should | |
134 be the name of a one-argument function, a string is used with a single | |
135 argument and an expression will be evaluated with the variable `num' | |
136 bound to whatever should be displayed. If it is a function symbol, it | |
137 should be able to handle special symbol arguments, currently 'left and | |
138 'right which will be sent by special keys to modify display parameters | |
139 associated with the displayer function (for example to change the number | |
140 of digits displayed). | |
141 | |
142 An exception to the above is the case of the list (std C) where C is a | |
143 character, in this case the `calculator-standard-displayer' function | |
62531
c905fcf5e3d9
Specify missing group (and type, if simple) in defcustom.
Juanma Barranquero <lekktu@gmail.com>
parents:
59056
diff
changeset
|
144 will be used with this character for a format string." |
c905fcf5e3d9
Specify missing group (and type, if simple) in defcustom.
Juanma Barranquero <lekktu@gmail.com>
parents:
59056
diff
changeset
|
145 :group 'calculator) |
33491 | 146 |
147 (defcustom calculator-displayers | |
43091
f18f05d77411
(calculator-displayers): Doc fixes.
Pavel Janík <Pavel@Janik.cz>
parents:
39818
diff
changeset
|
148 '(((std ?n) "Standard display, decimal point or scientific") |
33491 | 149 (calculator-eng-display "Eng display") |
150 ((std ?f) "Standard display, decimal point") | |
43091
f18f05d77411
(calculator-displayers): Doc fixes.
Pavel Janík <Pavel@Janik.cz>
parents:
39818
diff
changeset
|
151 ((std ?e) "Standard display, scientific") |
33491 | 152 ("%S" "Emacs printer")) |
100171 | 153 "A list of displayers. |
33491 | 154 Each element is a list of a displayer and a description string. The |
43091
f18f05d77411
(calculator-displayers): Doc fixes.
Pavel Janík <Pavel@Janik.cz>
parents:
39818
diff
changeset
|
155 first element is the one which is currently used, this is for the display |
33491 | 156 of result values not values in expressions. A displayer specification |
157 is the same as the values that can be stored in `calculator-displayer'. | |
158 | |
159 `calculator-rotate-displayer' rotates this list." | |
160 :type 'sexp | |
27587 | 161 :group 'calculator) |
162 | |
33491 | 163 (defcustom calculator-paste-decimals t |
100171 | 164 "If non-nil, convert pasted integers so they have a decimal point. |
33491 | 165 This makes it possible to paste big integers since they will be read as |
166 floats, otherwise the Emacs reader will fail on them." | |
27587 | 167 :type 'boolean |
168 :group 'calculator) | |
169 | |
39430
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
170 (defcustom calculator-copy-displayer nil |
100171 | 171 "If non-nil, this is any value that can be used for |
39430
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
172 `calculator-displayer', to format a string before copying it with |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
173 `calculator-copy'. If nil, then `calculator-displayer's normal value is |
62531
c905fcf5e3d9
Specify missing group (and type, if simple) in defcustom.
Juanma Barranquero <lekktu@gmail.com>
parents:
59056
diff
changeset
|
174 used." |
c905fcf5e3d9
Specify missing group (and type, if simple) in defcustom.
Juanma Barranquero <lekktu@gmail.com>
parents:
59056
diff
changeset
|
175 :type 'boolean |
c905fcf5e3d9
Specify missing group (and type, if simple) in defcustom.
Juanma Barranquero <lekktu@gmail.com>
parents:
59056
diff
changeset
|
176 :group 'calculator) |
39430
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
177 |
27587 | 178 (defcustom calculator-2s-complement nil |
100171 | 179 "If non-nil, show negative numbers in 2s complement in radix modes. |
27587 | 180 Otherwise show as a negative number." |
181 :type 'boolean | |
182 :group 'calculator) | |
183 | |
184 (defcustom calculator-mode-hook nil | |
100171 | 185 "List of hook functions for `calculator-mode' to run. |
59056
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
186 Note: if `calculator-electric-mode' is on, then this hook will get |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
187 activated in the minibuffer - in that case it should not do much more |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
188 than local key settings and other effects that will change things |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
189 outside the scope of calculator related code." |
27587 | 190 :type 'hook |
191 :group 'calculator) | |
192 | |
193 (defcustom calculator-user-registers nil | |
100171 | 194 "An association list of user-defined register bindings. |
27587 | 195 Each element in this list is a list of a character and a number that |
196 will be stored in that character's register. | |
197 | |
198 For example, use this to define the golden ratio number: | |
33491 | 199 (setq calculator-user-registers '((?g . 1.61803398875))) |
200 before you load calculator." | |
27587 | 201 :type '(repeat (cons character number)) |
202 :set '(lambda (_ val) | |
203 (and (boundp 'calculator-registers) | |
204 (setq calculator-registers | |
205 (append val calculator-registers))) | |
206 (setq calculator-user-registers val)) | |
207 :group 'calculator) | |
208 | |
209 (defcustom calculator-user-operators nil | |
100171 | 210 "A list of additional operators. |
27587 | 211 This is a list in the same format as specified in the documentation for |
212 `calculator-operators', that you can use to bind additional calculator | |
213 operators. It is probably not a good idea to modify this value with | |
214 `customize' since it is too complex... | |
215 | |
216 Examples: | |
217 | |
30889 | 218 * A very simple one, adding a postfix \"x-to-y\" conversion keys, using |
219 t as a prefix key: | |
27587 | 220 |
221 (setq calculator-user-operators | |
222 '((\"tf\" cl-to-fr (+ 32 (/ (* X 9) 5)) 1) | |
223 (\"tc\" fr-to-cl (/ (* (- X 32) 5) 9) 1) | |
224 (\"tp\" kg-to-lb (/ X 0.453592) 1) | |
225 (\"tk\" lb-to-kg (* X 0.453592) 1) | |
226 (\"tF\" mt-to-ft (/ X 0.3048) 1) | |
227 (\"tM\" ft-to-mt (* X 0.3048) 1))) | |
228 | |
229 * Using a function-like form is very simple, X for an argument (Y the | |
230 second in case of a binary operator), TX is a truncated version of X | |
231 and F does a recursive call, Here is a [very inefficient] Fibonacci | |
232 number calculation: | |
233 | |
234 (add-to-list 'calculator-user-operators | |
235 '(\"F\" fib (if (<= TX 1) | |
33491 | 236 1 |
237 (+ (F (- TX 1)) (F (- TX 2)))) 0)) | |
27587 | 238 |
239 Note that this will be either postfix or prefix, according to | |
240 `calculator-unary-style'." | |
241 :type '(repeat (list string symbol sexp integer integer)) | |
242 :group 'calculator) | |
243 | |
33631 | 244 ;;;===================================================================== |
27587 | 245 ;;; Code: |
246 | |
33631 | 247 ;;;--------------------------------------------------------------------- |
33491 | 248 ;;; Variables |
249 | |
27587 | 250 (defvar calculator-initial-operators |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
251 '(;; "+"/"-" have keybindings of themselves, not calculator-ops |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
252 ("=" = identity 1 -1) |
33491 | 253 (nobind "+" + + 2 4) |
254 (nobind "-" - - 2 4) | |
255 (nobind "+" + + -1 9) | |
256 (nobind "-" - - -1 9) | |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
257 ("(" \( identity -1 -1) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
258 (")" \) identity +1 10) |
27587 | 259 ;; normal keys |
260 ("|" or (logior TX TY) 2 2) | |
261 ("#" xor (logxor TX TY) 2 2) | |
262 ("&" and (logand TX TY) 2 3) | |
263 ("*" * * 2 5) | |
264 ("/" / / 2 5) | |
265 ("\\" div (/ TX TY) 2 5) | |
266 ("%" rem (% TX TY) 2 5) | |
267 ("L" log log 2 6) | |
268 ("S" sin (sin DX) x 6) | |
269 ("C" cos (cos DX) x 6) | |
270 ("T" tan (tan DX) x 6) | |
271 ("IS" asin (D (asin X)) x 6) | |
272 ("IC" acos (D (acos X)) x 6) | |
273 ("IT" atan (D (atan X)) x 6) | |
274 ("Q" sqrt sqrt x 7) | |
81696
c29faa83ba3a
(calculator-expt, calculator-integer-p): New functions.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75773
diff
changeset
|
275 ("^" ^ calculator-expt 2 7) |
27587 | 276 ("!" ! calculator-fact x 7) |
277 (";" 1/ (/ 1 X) 1 7) | |
278 ("_" - - 1 8) | |
279 ("~" ~ (lognot TX) x 8) | |
280 (">" repR calculator-repR 1 8) | |
281 ("<" repL calculator-repL 1 8) | |
282 ("v" avg (/ (apply '+ L) (length L)) 0 8) | |
283 ("l" tot (apply '+ L) 0 8) | |
284 ) | |
285 "A list of initial operators. | |
286 This is a list in the same format as `calculator-operators'. Whenever | |
287 `calculator' starts, it looks at the value of this variable, and if it | |
288 is not empty, its contents is prepended to `calculator-operators' and | |
289 the appropriate key bindings are made. | |
290 | |
291 This variable is then reset to nil. Don't use this if you want to add | |
292 user-defined operators, use `calculator-user-operators' instead.") | |
293 | |
294 (defvar calculator-operators nil | |
295 "The calculator operators, each a list with: | |
296 | |
297 1. The key that is bound to for this operation (usually a string); | |
298 | |
299 2. The displayed symbol for this function; | |
300 | |
301 3. The function symbol, or a form that uses the variables `X' and `Y', | |
302 (if it is a binary operator), `TX' and `TY' (truncated integer | |
303 versions), `DX' (converted to radians if degrees mode is on), `D' | |
304 (function for converting radians to degrees if deg mode is on), `L' | |
305 (list of saved values), `F' (function for recursive iteration calls) | |
306 and evaluates to the function value - these variables are capital; | |
307 | |
33491 | 308 4. The function's arity, optional, one of: 2 => binary, -1 => prefix |
309 unary, +1 => postfix unary, 0 => a 0-arg operator func, non-number => | |
310 postfix/prefix as determined by `calculator-unary-style' (the | |
311 default); | |
27587 | 312 |
33491 | 313 5. The function's precedence - should be in the range of 1 (lowest) to |
314 9 (highest) (optional, defaults to 1); | |
27587 | 315 |
316 It it possible have a unary prefix version of a binary operator if it | |
317 comes later in this list. If the list begins with the symbol 'nobind, | |
318 then no key binding will take place - this is only useful for predefined | |
319 keys. | |
320 | |
321 Use `calculator-user-operators' to add operators to this list, see its | |
322 documentation for an example.") | |
323 | |
324 (defvar calculator-stack nil | |
325 "Stack contents - operations and operands.") | |
326 | |
327 (defvar calculator-curnum nil | |
328 "Current number being entered (as a string).") | |
329 | |
330 (defvar calculator-stack-display nil | |
331 "Cons of the stack and its string representation.") | |
332 | |
333 (defvar calculator-char-radix | |
334 '((?D . nil) (?B . bin) (?O . oct) (?H . hex) (?X . hex)) | |
335 "A table to convert input characters to corresponding radix symbols.") | |
336 | |
337 (defvar calculator-output-radix nil | |
338 "The mode for display, one of: nil (decimal), 'bin, 'oct or 'hex.") | |
339 | |
340 (defvar calculator-input-radix nil | |
341 "The mode for input, one of: nil (decimal), 'bin, 'oct or 'hex.") | |
342 | |
343 (defvar calculator-deg nil | |
344 "Non-nil if trig functions operate on degrees instead of radians.") | |
345 | |
346 (defvar calculator-saved-list nil | |
347 "A list of saved values collected.") | |
348 | |
349 (defvar calculator-saved-ptr 0 | |
350 "The pointer to the current saved number.") | |
351 | |
352 (defvar calculator-add-saved nil | |
353 "Bound to t when a value should be added to the saved-list.") | |
354 | |
355 (defvar calculator-display-fragile nil | |
356 "When non-nil, we see something that the next digit should replace.") | |
357 | |
358 (defvar calculator-buffer nil | |
359 "The current calculator buffer.") | |
360 | |
33491 | 361 (defvar calculator-eng-extra nil |
362 "Internal value used by `calculator-eng-display'.") | |
363 | |
364 (defvar calculator-eng-tmp-show nil | |
365 "Internal value used by `calculator-eng-display'.") | |
366 | |
27587 | 367 (defvar calculator-last-opXY nil |
368 "The last binary operation and its arguments. | |
369 Used for repeating operations in calculator-repR/L.") | |
370 | |
371 (defvar calculator-registers ; use user-bindings first | |
372 (append calculator-user-registers (list (cons ?e e) (cons ?p pi))) | |
373 "The association list of calculator register values.") | |
374 | |
375 (defvar calculator-saved-global-map nil | |
376 "Saved global key map.") | |
377 | |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
378 (defvar calculator-restart-other-mode nil |
33491 | 379 "Used to hack restarting with the electric mode changed.") |
380 | |
33631 | 381 ;;;--------------------------------------------------------------------- |
33491 | 382 ;;; Key bindings |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
383 |
27587 | 384 (defvar calculator-mode-map nil |
385 "The calculator key map.") | |
386 | |
387 (or calculator-mode-map | |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
388 (let ((map (make-sparse-keymap))) |
27587 | 389 (suppress-keymap map t) |
390 (define-key map "i" nil) | |
391 (define-key map "o" nil) | |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
392 (let ((p |
33491 | 393 '((calculator-open-paren "[") |
394 (calculator-close-paren "]") | |
395 (calculator-op-or-exp "+" "-" [kp-add] [kp-subtract]) | |
396 (calculator-digit "0" "1" "2" "3" "4" "5" "6" "7" "8" | |
397 "9" "a" "b" "c" "d" "f" | |
398 [kp-0] [kp-1] [kp-2] [kp-3] [kp-4] | |
399 [kp-5] [kp-6] [kp-7] [kp-8] [kp-9]) | |
400 (calculator-op [kp-divide] [kp-multiply]) | |
401 (calculator-decimal "." [kp-decimal]) | |
402 (calculator-exp "e") | |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
403 (calculator-dec/deg-mode "D") |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
404 (calculator-set-register "s") |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
405 (calculator-get-register "g") |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
406 (calculator-radix-mode "H" "X" "O" "B") |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
407 (calculator-radix-input-mode "id" "ih" "ix" "io" "ib" |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
408 "iD" "iH" "iX" "iO" "iB") |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
409 (calculator-radix-output-mode "od" "oh" "ox" "oo" "ob" |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
410 "oD" "oH" "oX" "oO" "oB") |
33491 | 411 (calculator-rotate-displayer "'") |
412 (calculator-rotate-displayer-back "\"") | |
59056
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
413 (calculator-displayer-prev "{") |
39430
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
414 (calculator-displayer-next "}") |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
415 (calculator-saved-up [up] [?\C-p]) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
416 (calculator-saved-down [down] [?\C-n]) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
417 (calculator-quit "q" [?\C-g]) |
33491 | 418 (calculator-enter [enter] [linefeed] [kp-enter] |
419 [return] [?\r] [?\n]) | |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
420 (calculator-save-on-list " " [space]) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
421 (calculator-clear-saved [?\C-c] [(control delete)]) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
422 (calculator-save-and-quit [(control return)] |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
423 [(control kp-enter)]) |
33631 | 424 (calculator-paste [insert] [(shift insert)] |
59056
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
425 [paste] [mouse-2] [?\C-y]) |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
426 (calculator-clear [delete] [?\C-?] [?\C-d]) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
427 (calculator-help [?h] [??] [f1] [help]) |
59056
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
428 (calculator-copy [(control insert)] [copy]) |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
429 (calculator-backspace [backspace]) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
430 ))) |
27587 | 431 (while p |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
432 ;; reverse the keys so first defs come last - makes the more |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
433 ;; sensible bindings visible in the menu |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
434 (let ((func (car (car p))) (keys (reverse (cdr (car p))))) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
435 (while keys |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
436 (define-key map (car keys) func) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
437 (setq keys (cdr keys)))) |
27587 | 438 (setq p (cdr p)))) |
439 (if calculator-bind-escape | |
440 (progn (define-key map [?\e] 'calculator-quit) | |
441 (define-key map [escape] 'calculator-quit)) | |
442 (define-key map [?\e ?\e ?\e] 'calculator-quit)) | |
443 ;; make C-h work in text-mode | |
444 (or window-system (define-key map [?\C-h] 'calculator-backspace)) | |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
445 ;; set up a menu |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
446 (if (and calculator-use-menu (not (boundp 'calculator-menu))) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
447 (let ((radix-selectors |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
448 (mapcar (lambda (x) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
449 `([,(nth 0 x) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
450 (calculator-radix-mode ,(nth 2 x)) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
451 :style radio |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
452 :keys ,(nth 2 x) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
453 :selected |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
454 (and |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
455 (eq calculator-input-radix ',(nth 1 x)) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
456 (eq calculator-output-radix ',(nth 1 x)))] |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
457 [,(concat (nth 0 x) " Input") |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
458 (calculator-radix-input-mode ,(nth 2 x)) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
459 :keys ,(concat "i" (downcase (nth 2 x))) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
460 :style radio |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
461 :selected |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
462 (eq calculator-input-radix ',(nth 1 x))] |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
463 [,(concat (nth 0 x) " Output") |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
464 (calculator-radix-output-mode ,(nth 2 x)) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
465 :keys ,(concat "o" (downcase (nth 2 x))) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
466 :style radio |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
467 :selected |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
468 (eq calculator-output-radix ',(nth 1 x))])) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
469 '(("Decimal" nil "D") |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
470 ("Binary" bin "B") |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
471 ("Octal" oct "O") |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
472 ("Hexadecimal" hex "H")))) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
473 (op '(lambda (name key) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
474 `[,name (calculator-op ,key) :keys ,key]))) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
475 (easy-menu-define |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
476 calculator-menu map "Calculator menu." |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
477 `("Calculator" |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
478 ["Help" |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
479 (let ((last-command 'calculator-help)) (calculator-help)) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
480 :keys "?"] |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
481 "---" |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
482 ["Copy" calculator-copy] |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
483 ["Paste" calculator-paste] |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
484 "---" |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
485 ["Electric mode" |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
486 (progn (calculator-quit) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
487 (setq calculator-restart-other-mode t) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
488 (run-with-timer 0.1 nil '(lambda () (message nil))) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
489 ;; the message from the menu will be visible, |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
490 ;; couldn't make it go away... |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
491 (calculator)) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
492 :active (not calculator-electric-mode)] |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
493 ["Normal mode" |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
494 (progn (setq calculator-restart-other-mode t) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
495 (calculator-quit)) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
496 :active calculator-electric-mode] |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
497 "---" |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
498 ("Functions" |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
499 ,(funcall op "Repeat-right" ">") |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
500 ,(funcall op "Repeat-left" "<") |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
501 "------General------" |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
502 ,(funcall op "Reciprocal" ";") |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
503 ,(funcall op "Log" "L") |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
504 ,(funcall op "Square-root" "Q") |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
505 ,(funcall op "Factorial" "!") |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
506 "------Trigonometric------" |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
507 ,(funcall op "Sinus" "S") |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
508 ,(funcall op "Cosine" "C") |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
509 ,(funcall op "Tangent" "T") |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
510 ,(funcall op "Inv-Sinus" "IS") |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
511 ,(funcall op "Inv-Cosine" "IC") |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
512 ,(funcall op "Inv-Tangent" "IT") |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
513 "------Bitwise------" |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
514 ,(funcall op "Or" "|") |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
515 ,(funcall op "Xor" "#") |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
516 ,(funcall op "And" "&") |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
517 ,(funcall op "Not" "~")) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
518 ("Saved List" |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
519 ["Eval+Save" calculator-save-on-list] |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
520 ["Prev number" calculator-saved-up] |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
521 ["Next number" calculator-saved-down] |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
522 ["Delete current" calculator-clear |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
523 :active (and calculator-display-fragile |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
524 calculator-saved-list |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
525 (= (car calculator-stack) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
526 (nth calculator-saved-ptr |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
527 calculator-saved-list)))] |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
528 ["Delete all" calculator-clear-saved] |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
529 "---" |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
530 ,(funcall op "List-total" "l") |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
531 ,(funcall op "List-average" "v")) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
532 ("Registers" |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
533 ["Get register" calculator-get-register] |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
534 ["Set register" calculator-set-register]) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
535 ("Modes" |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
536 ["Radians" |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
537 (progn |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
538 (and (or calculator-input-radix calculator-output-radix) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
539 (calculator-radix-mode "D")) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
540 (and calculator-deg (calculator-dec/deg-mode))) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
541 :keys "D" |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
542 :style radio |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
543 :selected (not (or calculator-input-radix |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
544 calculator-output-radix |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
545 calculator-deg))] |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
546 ["Degrees" |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
547 (progn |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
548 (and (or calculator-input-radix calculator-output-radix) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
549 (calculator-radix-mode "D")) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
550 (or calculator-deg (calculator-dec/deg-mode))) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
551 :keys "D" |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
552 :style radio |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
553 :selected (and calculator-deg |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
554 (not (or calculator-input-radix |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
555 calculator-output-radix)))] |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
556 "---" |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
557 ,@(mapcar 'car radix-selectors) |
75773
8344ba1076b6
(calculator-mode-map): Fix typo in menu entry.
Juanma Barranquero <lekktu@gmail.com>
parents:
75762
diff
changeset
|
558 ("Separate I/O" |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
559 ,@(mapcar (lambda (x) (nth 1 x)) radix-selectors) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
560 "---" |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
561 ,@(mapcar (lambda (x) (nth 2 x)) radix-selectors))) |
59056
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
562 ("Decimal Display" |
33491 | 563 ,@(mapcar (lambda (d) |
564 (vector (cadr d) | |
565 ;; Note: inserts actual object here | |
566 `(calculator-rotate-displayer ',d))) | |
567 calculator-displayers) | |
568 "---" | |
39430
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
569 ["Change Prev Display" calculator-displayer-prev] |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
570 ["Change Next Display" calculator-displayer-next]) |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
571 "---" |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
572 ["Copy+Quit" calculator-save-and-quit] |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
573 ["Quit" calculator-quit])))) |
27587 | 574 (setq calculator-mode-map map))) |
575 | |
33631 | 576 ;;;--------------------------------------------------------------------- |
33491 | 577 ;;; Startup and mode stuff |
578 | |
27587 | 579 (defun calculator-mode () |
33491 | 580 ;; this help is also used as the major help screen |
581 "A [not so] simple calculator for Emacs. | |
27587 | 582 |
583 This calculator is used in the same way as other popular calculators | |
584 like xcalc or calc.exe - but using an Emacs interface. | |
585 | |
586 Expressions are entered using normal infix notation, parens are used as | |
587 normal. Unary functions are usually postfix, but some depends on the | |
588 value of `calculator-unary-style' (if the style for an operator below is | |
589 specified, then it is fixed, otherwise it depends on this variable). | |
590 `+' and `-' can be used as either binary operators or prefix unary | |
591 operators. Numbers can be entered with exponential notation using `e', | |
592 except when using a non-decimal radix mode for input (in this case `e' | |
81696
c29faa83ba3a
(calculator-expt, calculator-integer-p): New functions.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75773
diff
changeset
|
593 will be the hexadecimal digit). If the result of a calculation is too |
c29faa83ba3a
(calculator-expt, calculator-integer-p): New functions.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75773
diff
changeset
|
594 large (out of range for Emacs), the value of \"inf\" is returned. |
27587 | 595 |
596 Here are the editing keys: | |
597 * `RET' `=' evaluate the current expression | |
598 * `C-insert' copy the whole current expression to the `kill-ring' | |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
599 * `C-return' evaluate, save result the `kill-ring' and exit |
27587 | 600 * `insert' paste a number if the one was copied (normally) |
601 * `delete' `C-d' clear last argument or whole expression (hit twice) | |
602 * `backspace' delete a digit or a previous expression element | |
603 * `h' `?' pop-up a quick reference help | |
604 * `ESC' `q' exit (`ESC' can be used if `calculator-bind-escape' is | |
605 non-nil, otherwise use three consecutive `ESC's) | |
606 | |
607 These operators are pre-defined: | |
608 * `+' `-' `*' `/' the common binary operators | |
609 * `\\' `%' integer division and reminder | |
610 * `_' `;' postfix unary negation and reciprocal | |
611 * `^' `L' binary operators for x^y and log(x) in base y | |
612 * `Q' `!' unary square root and factorial | |
613 * `S' `C' `T' unary trigonometric operators - sin, cos and tan | |
614 * `|' `#' `&' `~' bitwise operators - or, xor, and, not | |
615 | |
616 The trigonometric functions can be inverted if prefixed with an `I', see | |
617 below for the way to use degrees instead of the default radians. | |
618 | |
619 Two special postfix unary operators are `>' and `<': whenever a binary | |
620 operator is performed, it is remembered along with its arguments; then | |
621 `>' (`<') will apply the same operator with the same right (left) | |
622 argument. | |
623 | |
624 hex/oct/bin modes can be set for input and for display separately. | |
625 Another toggle-able mode is for using degrees instead of radians for | |
626 trigonometric functions. | |
627 The keys to switch modes are (`X' is shortcut for `H'): | |
628 * `D' switch to all-decimal mode, or toggle degrees/radians | |
629 * `B' `O' `H' `X' binary/octal/hexadecimal modes for input & display | |
630 * `i' `o' followed by one of `D' `B' `O' `H' `X' (case | |
631 insensitive) sets only the input or display radix mode | |
632 The prompt indicates the current modes: | |
633 * \"D=\": degrees mode; | |
634 * \"?=\": (? is B/O/H) this is the radix for both input and output; | |
635 * \"=?\": (? is B/O/H) the display radix (when input is decimal); | |
636 * \"??\": (? is D/B/O/H) 1st char for input radix, 2nd for display. | |
637 | |
59056
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
638 Also, the quote key can be used to switch display modes for decimal |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
639 numbers (double-quote rotates back), and the two brace characters |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
640 \(\"{\" and \"}\" change display parameters that these displayers use (if |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
641 they handle such). If output is using any radix mode, then these keys |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
642 toggle digit grouping mode and the chunk size. |
33491 | 643 |
27587 | 644 Values can be saved for future reference in either a list of saved |
645 values, or in registers. | |
646 | |
647 The list of saved values is useful for statistics operations on some | |
648 collected data. It is possible to navigate in this list, and if the | |
649 value shown is the current one on the list, an indication is displayed | |
650 as \"[N]\" if this is the last number and there are N numbers, or | |
651 \"[M/N]\" if the M-th value is shown. | |
652 * `SPC' evaluate the current value as usual, but also adds | |
653 the result to the list of saved values | |
654 * `l' `v' computes total / average of saved values | |
655 * `up' `C-p' browse to the previous value in the list | |
656 * `down' `C-n' browse to the next value in the list | |
657 * `delete' `C-d' remove current value from the list (if it is on it) | |
658 * `C-delete' `C-c' delete the whole list | |
659 | |
660 Registers are variable-like place-holders for values: | |
661 * `s' followed by a character attach the current value to that character | |
662 * `g' followed by a character fetches the attached value | |
663 | |
664 There are many variables that can be used to customize the calculator. | |
665 Some interesting customization variables are: | |
666 * `calculator-electric-mode' use only the echo-area electrically. | |
667 * `calculator-unary-style' set most unary ops to pre/postfix style. | |
668 * `calculator-user-registers' to define user-preset registers. | |
669 * `calculator-user-operators' to add user-defined operators. | |
670 See the documentation for these variables, and \"calculator.el\" for | |
671 more information. | |
672 | |
673 \\{calculator-mode-map}" | |
674 (interactive) | |
675 (kill-all-local-variables) | |
676 (setq major-mode 'calculator-mode) | |
677 (setq mode-name "Calculator") | |
678 (use-local-map calculator-mode-map) | |
62720
eb01420c0088
(calculator-mode): Use run-mode-hooks.
Lute Kamstra <lute@gnu.org>
parents:
62531
diff
changeset
|
679 (run-mode-hooks 'calculator-mode-hook)) |
27587 | 680 |
33491 | 681 (eval-when-compile (require 'electric) (require 'ehelp)) |
682 | |
27587 | 683 ;;;###autoload |
684 (defun calculator () | |
33491 | 685 "Run the Emacs calculator. |
27587 | 686 See the documentation for `calculator-mode' for more information." |
687 (interactive) | |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
688 (if calculator-restart-other-mode |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
689 (setq calculator-electric-mode (not calculator-electric-mode))) |
27587 | 690 (if calculator-initial-operators |
691 (progn (calculator-add-operators calculator-initial-operators) | |
692 (setq calculator-initial-operators nil) | |
693 ;; don't change this since it is a customization variable, | |
33491 | 694 ;; its set function will add any new operators |
27587 | 695 (calculator-add-operators calculator-user-operators))) |
49575
336c18b62203
(calculator): Don't use the minibuffer even in electric mode; use a private
Juanma Barranquero <lekktu@gmail.com>
parents:
43091
diff
changeset
|
696 (setq calculator-buffer (get-buffer-create "*calculator*")) |
27587 | 697 (if calculator-electric-mode |
698 (save-window-excursion | |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
699 (progn (require 'electric) (message nil)) ; hide load message |
27587 | 700 (let (old-g-map old-l-map (echo-keystrokes 0) |
701 (garbage-collection-messages nil)) ; no gc msg when electric | |
49575
336c18b62203
(calculator): Don't use the minibuffer even in electric mode; use a private
Juanma Barranquero <lekktu@gmail.com>
parents:
43091
diff
changeset
|
702 (set-window-buffer (minibuffer-window) calculator-buffer) |
27587 | 703 (select-window (minibuffer-window)) |
704 (calculator-reset) | |
705 (calculator-update-display) | |
706 (setq old-l-map (current-local-map)) | |
707 (setq old-g-map (current-global-map)) | |
708 (setq calculator-saved-global-map (current-global-map)) | |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
709 (use-local-map nil) |
27587 | 710 (use-global-map calculator-mode-map) |
59056
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
711 (run-hooks 'calculator-mode-hook) |
27587 | 712 (unwind-protect |
713 (catch 'calculator-done | |
714 (Electric-command-loop | |
715 'calculator-done | |
716 ;; can't use 'noprompt, bug in electric.el | |
717 '(lambda () 'noprompt) | |
718 nil | |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
719 (lambda (x y) (calculator-update-display)))) |
27587 | 720 (and calculator-buffer |
721 (catch 'calculator-done (calculator-quit))) | |
722 (use-local-map old-l-map) | |
723 (use-global-map old-g-map)))) | |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
724 (progn |
39430
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
725 (cond |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
726 ((not (get-buffer-window calculator-buffer)) |
107342
176028ab9fc6
* calculator.el (calculator): Don't bind split-window-keep-point (Bug#5674).
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
727 (let ((window-min-height 2)) |
39430
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
728 ;; maybe leave two lines for our window because of the normal |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
729 ;; `raised' modeline in Emacs 21 |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
730 (select-window |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
731 (split-window-vertically |
75757
fa4ebb68ab30
(calculator): Do more extensive checking for when 3 lines should be
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75347
diff
changeset
|
732 ;; If the modeline might interfere with the calculator buffer, |
75773
8344ba1076b6
(calculator-mode-map): Fix typo in menu entry.
Juanma Barranquero <lekktu@gmail.com>
parents:
75762
diff
changeset
|
733 ;; use 3 lines instead. |
39430
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
734 (if (and (fboundp 'face-attr-construct) |
75762
a57328de9ea2
(calculator): Adjust previous adjustment.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75757
diff
changeset
|
735 (let* ((dh (plist-get (face-attr-construct 'default) :height)) |
a57328de9ea2
(calculator): Adjust previous adjustment.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75757
diff
changeset
|
736 (mf (face-attr-construct 'modeline)) |
a57328de9ea2
(calculator): Adjust previous adjustment.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75757
diff
changeset
|
737 (mh (plist-get mf :height))) |
75773
8344ba1076b6
(calculator-mode-map): Fix typo in menu entry.
Juanma Barranquero <lekktu@gmail.com>
parents:
75762
diff
changeset
|
738 ;; If the modeline is shorter than the default, |
8344ba1076b6
(calculator-mode-map): Fix typo in menu entry.
Juanma Barranquero <lekktu@gmail.com>
parents:
75762
diff
changeset
|
739 ;; stick with 2 lines. (It may be necessary to |
75762
a57328de9ea2
(calculator): Adjust previous adjustment.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75757
diff
changeset
|
740 ;; check how much shorter.) |
a57328de9ea2
(calculator): Adjust previous adjustment.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75757
diff
changeset
|
741 (and |
a57328de9ea2
(calculator): Adjust previous adjustment.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75757
diff
changeset
|
742 (not |
a57328de9ea2
(calculator): Adjust previous adjustment.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75757
diff
changeset
|
743 (or (and (integerp dh) |
a57328de9ea2
(calculator): Adjust previous adjustment.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75757
diff
changeset
|
744 (integerp mh) |
a57328de9ea2
(calculator): Adjust previous adjustment.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75757
diff
changeset
|
745 (< mh dh)) |
a57328de9ea2
(calculator): Adjust previous adjustment.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75757
diff
changeset
|
746 (and (numberp mh) |
a57328de9ea2
(calculator): Adjust previous adjustment.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75757
diff
changeset
|
747 (not (integerp mh)) |
a57328de9ea2
(calculator): Adjust previous adjustment.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75757
diff
changeset
|
748 (< mh 1)))) |
a57328de9ea2
(calculator): Adjust previous adjustment.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75757
diff
changeset
|
749 (or |
a57328de9ea2
(calculator): Adjust previous adjustment.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75757
diff
changeset
|
750 ;; If the modeline is taller than the default, |
a57328de9ea2
(calculator): Adjust previous adjustment.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75757
diff
changeset
|
751 ;; use 3 lines. |
a57328de9ea2
(calculator): Adjust previous adjustment.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75757
diff
changeset
|
752 (and (integerp dh) |
a57328de9ea2
(calculator): Adjust previous adjustment.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75757
diff
changeset
|
753 (integerp mh) |
a57328de9ea2
(calculator): Adjust previous adjustment.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75757
diff
changeset
|
754 (> mh dh)) |
a57328de9ea2
(calculator): Adjust previous adjustment.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75757
diff
changeset
|
755 (and (numberp mh) |
a57328de9ea2
(calculator): Adjust previous adjustment.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75757
diff
changeset
|
756 (not (integerp mh)) |
a57328de9ea2
(calculator): Adjust previous adjustment.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75757
diff
changeset
|
757 (> mh 1)) |
a57328de9ea2
(calculator): Adjust previous adjustment.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75757
diff
changeset
|
758 ;; If the modeline has a box with non-negative line-width, |
a57328de9ea2
(calculator): Adjust previous adjustment.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75757
diff
changeset
|
759 ;; use 3 lines. |
a57328de9ea2
(calculator): Adjust previous adjustment.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75757
diff
changeset
|
760 (let* ((bx (plist-get mf :box)) |
a57328de9ea2
(calculator): Adjust previous adjustment.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75757
diff
changeset
|
761 (lh (plist-get bx :line-width))) |
a57328de9ea2
(calculator): Adjust previous adjustment.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75757
diff
changeset
|
762 (and bx |
75773
8344ba1076b6
(calculator-mode-map): Fix typo in menu entry.
Juanma Barranquero <lekktu@gmail.com>
parents:
75762
diff
changeset
|
763 (or |
75762
a57328de9ea2
(calculator): Adjust previous adjustment.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75757
diff
changeset
|
764 (not lh) |
a57328de9ea2
(calculator): Adjust previous adjustment.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75757
diff
changeset
|
765 (> lh 0)))) |
a57328de9ea2
(calculator): Adjust previous adjustment.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75757
diff
changeset
|
766 ;; If the modeline has an overline, use 3 lines. |
a57328de9ea2
(calculator): Adjust previous adjustment.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75757
diff
changeset
|
767 (plist-get (face-attr-construct 'modeline) :overline))))) |
39430
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
768 -3 -2))) |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
769 (switch-to-buffer calculator-buffer))) |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
770 ((not (eq (current-buffer) calculator-buffer)) |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
771 (select-window (get-buffer-window calculator-buffer)))) |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
772 (calculator-mode) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
773 (setq buffer-read-only t) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
774 (calculator-reset) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
775 (message "Hit `?' For a quick help screen."))) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
776 (if (and calculator-restart-other-mode calculator-electric-mode) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
777 (calculator))) |
27587 | 778 |
59056
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
779 (defun calculator-message (string &rest arguments) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
780 "Same as `message', but special handle of electric mode." |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
781 (apply 'message string arguments) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
782 (if calculator-electric-mode |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
783 (progn (sit-for 1) (message nil)))) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
784 |
33631 | 785 ;;;--------------------------------------------------------------------- |
43091
f18f05d77411
(calculator-displayers): Doc fixes.
Pavel Janík <Pavel@Janik.cz>
parents:
39818
diff
changeset
|
786 ;;; Operators |
33491 | 787 |
27587 | 788 (defun calculator-op-arity (op) |
789 "Return OP's arity, 2, +1 or -1." | |
790 (let ((arity (or (nth 3 op) 'x))) | |
791 (if (numberp arity) | |
792 arity | |
793 (if (eq calculator-unary-style 'postfix) +1 -1)))) | |
794 | |
795 (defun calculator-op-prec (op) | |
796 "Return OP's precedence for reducing when inserting into the stack. | |
797 Defaults to 1." | |
798 (or (nth 4 op) 1)) | |
799 | |
800 (defun calculator-add-operators (more-ops) | |
801 "This function handles operator addition. | |
802 Adds MORE-OPS to `calculator-operator', called initially to handle | |
803 `calculator-initial-operators' and `calculator-user-operators'." | |
804 (let ((added-ops nil)) | |
805 (while more-ops | |
806 (or (eq (car (car more-ops)) 'nobind) | |
807 (let ((i -1) (key (car (car more-ops)))) | |
808 ;; make sure the key is undefined, so it's easy to define | |
809 ;; prefix keys | |
810 (while (< (setq i (1+ i)) (length key)) | |
811 (or (keymapp | |
812 (lookup-key calculator-mode-map | |
813 (substring key 0 (1+ i)))) | |
814 (progn | |
815 (define-key | |
816 calculator-mode-map (substring key 0 (1+ i)) nil) | |
817 (setq i (length key))))) | |
818 (define-key calculator-mode-map key 'calculator-op))) | |
819 (setq added-ops (cons (if (eq (car (car more-ops)) 'nobind) | |
820 (cdr (car more-ops)) | |
821 (car more-ops)) | |
822 added-ops)) | |
823 (setq more-ops (cdr more-ops))) | |
824 ;; added-ops come first, but in correct order | |
825 (setq calculator-operators | |
826 (append (nreverse added-ops) calculator-operators)))) | |
827 | |
33631 | 828 ;;;--------------------------------------------------------------------- |
33491 | 829 ;;; Display stuff |
830 | |
27587 | 831 (defun calculator-reset () |
832 "Reset calculator variables." | |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
833 (or calculator-restart-other-mode |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
834 (setq calculator-stack nil |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
835 calculator-curnum nil |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
836 calculator-stack-display nil |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
837 calculator-display-fragile nil)) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
838 (setq calculator-restart-other-mode nil) |
27587 | 839 (calculator-update-display)) |
840 | |
841 (defun calculator-get-prompt () | |
842 "Return a string to display. | |
843 The string is set not to exceed the screen width." | |
844 (let* ((calculator-prompt | |
845 (format calculator-prompt | |
846 (cond | |
847 ((or calculator-output-radix calculator-input-radix) | |
848 (if (eq calculator-output-radix | |
849 calculator-input-radix) | |
850 (concat | |
851 (char-to-string | |
852 (car (rassq calculator-output-radix | |
853 calculator-char-radix))) | |
854 "=") | |
855 (concat | |
856 (if calculator-input-radix | |
857 (char-to-string | |
858 (car (rassq calculator-input-radix | |
859 calculator-char-radix))) | |
860 "=") | |
861 (char-to-string | |
862 (car (rassq calculator-output-radix | |
863 calculator-char-radix)))))) | |
864 (calculator-deg "D=") | |
865 (t "==")))) | |
866 (prompt | |
867 (concat calculator-prompt | |
868 (cdr calculator-stack-display) | |
869 (cond (calculator-curnum | |
870 ;; number being typed | |
871 (concat calculator-curnum "_")) | |
872 ((and (= 1 (length calculator-stack)) | |
873 calculator-display-fragile) | |
874 ;; only the result is shown, next number will | |
875 ;; restart | |
876 nil) | |
877 (t | |
878 ;; waiting for a number or an operator | |
879 "?")))) | |
880 (trim (- (length prompt) (1- (window-width))))) | |
881 (if (<= trim 0) | |
882 prompt | |
883 (concat calculator-prompt | |
884 (substring prompt (+ trim (length calculator-prompt))))))) | |
885 | |
59056
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
886 (defun calculator-string-to-number (str) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
887 "Convert the given STR to a number, according to the value of |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
888 `calculator-input-radix'." |
27587 | 889 (if calculator-input-radix |
890 (let ((radix | |
891 (cdr (assq calculator-input-radix | |
892 '((bin . 2) (oct . 8) (hex . 16))))) | |
59056
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
893 (i -1) (value 0) (new-value 0)) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
894 ;; assume mostly valid input (e.g., characters in range) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
895 (while (< (setq i (1+ i)) (length str)) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
896 (setq new-value |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
897 (let* ((ch (upcase (aref str i))) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
898 (n (cond ((< ch ?0) nil) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
899 ((<= ch ?9) (- ch ?0)) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
900 ((< ch ?A) nil) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
901 ((<= ch ?Z) (- ch (- ?A 10))) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
902 (t nil)))) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
903 (if (and n (<= 0 n) (< n radix)) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
904 (+ n (* radix value)) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
905 (progn |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
906 (calculator-message |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
907 "Warning: Ignoring bad input character `%c'." ch) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
908 (sit-for 1) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
909 value)))) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
910 (if (if (< new-value 0) (> value 0) (< value 0)) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
911 (calculator-message "Warning: Overflow in input.")) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
912 (setq value new-value)) |
27587 | 913 value) |
59056
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
914 (car (read-from-string |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
915 (cond ((equal "." str) "0.0") |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
916 ((string-match "[eE][+-]?$" str) (concat str "0")) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
917 ((string-match "\\.[0-9]\\|[eE]" str) str) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
918 ((string-match "\\." str) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
919 ;; do this because Emacs reads "23." as an integer |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
920 (concat str "0")) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
921 ((stringp str) (concat str ".0")) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
922 (t "0.0")))))) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
923 |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
924 (defun calculator-curnum-value () |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
925 "Get the numeric value of the displayed number string as a float." |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
926 (calculator-string-to-number calculator-curnum)) |
27587 | 927 |
33491 | 928 (defun calculator-rotate-displayer (&optional new-disp) |
929 "Switch to the next displayer on the `calculator-displayers' list. | |
930 Can be called with an optional argument NEW-DISP to force rotation to | |
59056
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
931 that argument. |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
932 If radix output mode is active, toggle digit grouping." |
33491 | 933 (interactive) |
59056
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
934 (cond |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
935 (calculator-output-radix |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
936 (setq calculator-radix-grouping-mode |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
937 (not calculator-radix-grouping-mode)) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
938 (calculator-message |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
939 "Digit grouping mode %s." |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
940 (if calculator-radix-grouping-mode "ON" "OFF"))) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
941 (t |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
942 (setq calculator-displayers |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
943 (if (and new-disp (memq new-disp calculator-displayers)) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
944 (let ((tmp nil)) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
945 (while (not (eq (car calculator-displayers) new-disp)) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
946 (setq tmp (cons (car calculator-displayers) tmp)) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
947 (setq calculator-displayers |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
948 (cdr calculator-displayers))) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
949 (setq calculator-displayers |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
950 (nconc calculator-displayers (nreverse tmp)))) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
951 (nconc (cdr calculator-displayers) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
952 (list (car calculator-displayers))))) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
953 (calculator-message |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
954 "Using %s." (cadr (car calculator-displayers))))) |
33491 | 955 (calculator-enter)) |
956 | |
957 (defun calculator-rotate-displayer-back () | |
59056
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
958 "Like `calculator-rotate-displayer', but rotates modes back. |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
959 If radix output mode is active, toggle digit grouping." |
33491 | 960 (interactive) |
961 (calculator-rotate-displayer (car (last calculator-displayers)))) | |
962 | |
39430
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
963 (defun calculator-displayer-prev () |
33491 | 964 "Send the current displayer function a 'left argument. |
965 This is used to modify display arguments (if the current displayer | |
59056
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
966 function supports this). |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
967 If radix output mode is active, increase the grouping size." |
33491 | 968 (interactive) |
59056
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
969 (if calculator-output-radix |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
970 (progn (setq calculator-radix-grouping-digits |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
971 (1+ calculator-radix-grouping-digits)) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
972 (calculator-enter)) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
973 (and (car calculator-displayers) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
974 (let ((disp (caar calculator-displayers))) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
975 (cond |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
976 ((symbolp disp) (funcall disp 'left)) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
977 ((and (consp disp) (eq 'std (car disp))) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
978 (calculator-standard-displayer 'left (cadr disp)))))))) |
33491 | 979 |
39430
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
980 (defun calculator-displayer-next () |
33491 | 981 "Send the current displayer function a 'right argument. |
982 This is used to modify display arguments (if the current displayer | |
59056
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
983 function supports this). |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
984 If radix output mode is active, decrease the grouping size." |
33491 | 985 (interactive) |
59056
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
986 (if calculator-output-radix |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
987 (progn (setq calculator-radix-grouping-digits |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
988 (max 2 (1- calculator-radix-grouping-digits))) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
989 (calculator-enter)) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
990 (and (car calculator-displayers) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
991 (let ((disp (caar calculator-displayers))) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
992 (cond |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
993 ((symbolp disp) (funcall disp 'right)) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
994 ((and (consp disp) (eq 'std (car disp))) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
995 (calculator-standard-displayer 'right (cadr disp)))))))) |
33491 | 996 |
997 (defun calculator-remove-zeros (numstr) | |
99899
2796739a5e4f
* calculator.el (calculator-op-or-exp): Reflow docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
94680
diff
changeset
|
998 "Get a number string NUMSTR and remove unnecessary zeros. |
2796739a5e4f
* calculator.el (calculator-op-or-exp): Reflow docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
94680
diff
changeset
|
999 The behavior of this function is controlled by |
33491 | 1000 `calculator-remove-zeros'." |
1001 (cond ((and (eq calculator-remove-zeros t) | |
1002 (string-match "\\.0+\\([eE][+-]?[0-9]*\\)?$" numstr)) | |
1003 ;; remove all redundant zeros leaving an integer | |
1004 (if (match-beginning 1) | |
1005 (concat (substring numstr 0 (match-beginning 0)) | |
1006 (match-string 1 numstr)) | |
1007 (substring numstr 0 (match-beginning 0)))) | |
1008 ((and calculator-remove-zeros | |
1009 (string-match | |
1010 "\\..\\([0-9]*[1-9]\\)?\\(0+\\)\\([eE][+-]?[0-9]*\\)?$" | |
1011 numstr)) | |
1012 ;; remove zeros, except for first after the "." | |
1013 (if (match-beginning 3) | |
1014 (concat (substring numstr 0 (match-beginning 2)) | |
1015 (match-string 3 numstr)) | |
1016 (substring numstr 0 (match-beginning 2)))) | |
1017 (t numstr))) | |
1018 | |
1019 (defun calculator-standard-displayer (num char) | |
1020 "Standard display function, used to display NUM. | |
1021 Its behavior is determined by `calculator-number-digits' and the given | |
1022 CHAR argument (both will be used to compose a format string). If the | |
1023 char is \"n\" then this function will choose one between %f or %e, this | |
1024 is a work around %g jumping to exponential notation too fast. | |
1025 | |
1026 The special 'left and 'right symbols will make it change the current | |
1027 number of digits displayed (`calculator-number-digits'). | |
1028 | |
1029 It will also remove redundant zeros from the result." | |
1030 (if (symbolp num) | |
1031 (cond ((eq num 'left) | |
1032 (and (> calculator-number-digits 0) | |
1033 (setq calculator-number-digits | |
1034 (1- calculator-number-digits)) | |
1035 (calculator-enter))) | |
1036 ((eq num 'right) | |
1037 (setq calculator-number-digits | |
1038 (1+ calculator-number-digits)) | |
1039 (calculator-enter))) | |
39430
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1040 (let ((str (if (zerop num) |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1041 "0" |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1042 (format |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1043 (concat "%." |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1044 (number-to-string calculator-number-digits) |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1045 (if (eq char ?n) |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1046 (let ((n (abs num))) |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1047 (if (or (< n 0.001) (> n 1e8)) "e" "f")) |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1048 (string char))) |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1049 num)))) |
33491 | 1050 (calculator-remove-zeros str)))) |
1051 | |
1052 (defun calculator-eng-display (num) | |
1053 "Display NUM in engineering notation. | |
1054 The number of decimal digits used is controlled by | |
1055 `calculator-number-digits', so to change it at runtime you have to use | |
1056 the 'left or 'right when one of the standard modes is used." | |
1057 (if (symbolp num) | |
1058 (cond ((eq num 'left) | |
1059 (setq calculator-eng-extra | |
1060 (if calculator-eng-extra | |
1061 (1+ calculator-eng-extra) | |
1062 1)) | |
1063 (let ((calculator-eng-tmp-show t)) (calculator-enter))) | |
1064 ((eq num 'right) | |
1065 (setq calculator-eng-extra | |
1066 (if calculator-eng-extra | |
1067 (1- calculator-eng-extra) | |
1068 -1)) | |
1069 (let ((calculator-eng-tmp-show t)) (calculator-enter)))) | |
1070 (let ((exp 0)) | |
1071 (and (not (= 0 num)) | |
1072 (progn | |
1073 (while (< (abs num) 1.0) | |
1074 (setq num (* num 1000.0)) (setq exp (- exp 3))) | |
1075 (while (> (abs num) 999.0) | |
1076 (setq num (/ num 1000.0)) (setq exp (+ exp 3))) | |
1077 (and calculator-eng-tmp-show | |
1078 (not (= 0 calculator-eng-extra)) | |
1079 (let ((i calculator-eng-extra)) | |
1080 (while (> i 0) | |
1081 (setq num (* num 1000.0)) (setq exp (- exp 3)) | |
1082 (setq i (1- i))) | |
1083 (while (< i 0) | |
1084 (setq num (/ num 1000.0)) (setq exp (+ exp 3)) | |
1085 (setq i (1+ i))))))) | |
1086 (or calculator-eng-tmp-show (setq calculator-eng-extra nil)) | |
39818
6564021e098e
(calculator-eng-display): Don't call concat
Gerd Moellmann <gerd@gnu.org>
parents:
39430
diff
changeset
|
1087 (let ((str (format (concat "%." (number-to-string |
6564021e098e
(calculator-eng-display): Don't call concat
Gerd Moellmann <gerd@gnu.org>
parents:
39430
diff
changeset
|
1088 calculator-number-digits) |
6564021e098e
(calculator-eng-display): Don't call concat
Gerd Moellmann <gerd@gnu.org>
parents:
39430
diff
changeset
|
1089 "f") |
33491 | 1090 num))) |
1091 (concat (let ((calculator-remove-zeros | |
1092 ;; make sure we don't leave integers | |
1093 (and calculator-remove-zeros 'x))) | |
1094 (calculator-remove-zeros str)) | |
1095 "e" (number-to-string exp)))))) | |
1096 | |
59056
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
1097 (defun calculator-number-to-string (num) |
27587 | 1098 "Convert NUM to a displayable string." |
1099 (cond | |
1100 ((and (numberp num) calculator-output-radix) | |
1101 ;; print with radix - for binary I convert the octal number | |
1102 (let ((str (format (if (eq calculator-output-radix 'hex) "%x" "%o") | |
1103 (calculator-truncate | |
1104 (if calculator-2s-complement num (abs num)))))) | |
1105 (if (eq calculator-output-radix 'bin) | |
1106 (let ((i -1) (s "")) | |
1107 (while (< (setq i (1+ i)) (length str)) | |
1108 (setq s | |
1109 (concat s | |
1110 (cdr (assq (aref str i) | |
1111 '((?0 . "000") (?1 . "001") | |
1112 (?2 . "010") (?3 . "011") | |
1113 (?4 . "100") (?5 . "101") | |
1114 (?6 . "110") (?7 . "111"))))))) | |
1115 (string-match "^0*\\(.+\\)" s) | |
1116 (setq str (match-string 1 s)))) | |
59056
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
1117 (if calculator-radix-grouping-mode |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
1118 (let ((d (/ (length str) calculator-radix-grouping-digits)) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
1119 (r (% (length str) calculator-radix-grouping-digits))) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
1120 (while (>= (setq d (1- d)) (if (zerop r) 1 0)) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
1121 (let ((i (+ r (* d calculator-radix-grouping-digits)))) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
1122 (setq str (concat (substring str 0 i) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
1123 calculator-radix-grouping-separator |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
1124 (substring str i))))))) |
27587 | 1125 (upcase |
1126 (if (and (not calculator-2s-complement) (< num 0)) | |
1127 (concat "-" str) | |
1128 str)))) | |
39430
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1129 ((and (numberp num) calculator-displayer) |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1130 (cond |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1131 ((stringp calculator-displayer) |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1132 (format calculator-displayer num)) |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1133 ((symbolp calculator-displayer) |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1134 (funcall calculator-displayer num)) |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1135 ((and (consp calculator-displayer) |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1136 (eq 'std (car calculator-displayer))) |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1137 (calculator-standard-displayer num (cadr calculator-displayer))) |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1138 ((listp calculator-displayer) |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1139 (eval calculator-displayer)) |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1140 (t (prin1-to-string num t)))) |
33491 | 1141 ;; operators are printed here |
27587 | 1142 (t (prin1-to-string (nth 1 num) t)))) |
1143 | |
1144 (defun calculator-update-display (&optional force) | |
1145 "Update the display. | |
1146 If optional argument FORCE is non-nil, don't use the cached string." | |
1147 (set-buffer calculator-buffer) | |
1148 ;; update calculator-stack-display | |
1149 (if (or force | |
1150 (not (eq (car calculator-stack-display) calculator-stack))) | |
1151 (setq calculator-stack-display | |
1152 (cons calculator-stack | |
1153 (if calculator-stack | |
1154 (concat | |
39430
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1155 (let ((calculator-displayer |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1156 (if (and calculator-displayers |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1157 (= 1 (length calculator-stack))) |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1158 ;; customizable display for a single value |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1159 (caar calculator-displayers) |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1160 calculator-displayer))) |
59056
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
1161 (mapconcat 'calculator-number-to-string |
39430
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1162 (reverse calculator-stack) |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1163 " ")) |
27587 | 1164 " " |
1165 (and calculator-display-fragile | |
1166 calculator-saved-list | |
1167 (= (car calculator-stack) | |
1168 (nth calculator-saved-ptr | |
1169 calculator-saved-list)) | |
1170 (if (= 0 calculator-saved-ptr) | |
1171 (format "[%s]" (length calculator-saved-list)) | |
1172 (format "[%s/%s]" | |
1173 (- (length calculator-saved-list) | |
1174 calculator-saved-ptr) | |
1175 (length calculator-saved-list))))) | |
1176 "")))) | |
1177 (let ((inhibit-read-only t)) | |
1178 (erase-buffer) | |
1179 (insert (calculator-get-prompt))) | |
1180 (set-buffer-modified-p nil) | |
1181 (if calculator-display-fragile | |
1182 (goto-char (1+ (length calculator-prompt))) | |
1183 (goto-char (1- (point))))) | |
1184 | |
33631 | 1185 ;;;--------------------------------------------------------------------- |
33491 | 1186 ;;; Stack computations |
1187 | |
27587 | 1188 (defun calculator-reduce-stack (prec) |
1189 "Reduce the stack using top operator. | |
1190 PREC is a precedence - reduce everything with higher precedence." | |
1191 (while | |
1192 (cond | |
1193 ((and (cdr (cdr calculator-stack)) ; have three values | |
1194 (consp (nth 0 calculator-stack)) ; two operators & num | |
1195 (numberp (nth 1 calculator-stack)) | |
1196 (consp (nth 2 calculator-stack)) | |
1197 (eq '\) (nth 1 (nth 0 calculator-stack))) | |
1198 (eq '\( (nth 1 (nth 2 calculator-stack)))) | |
1199 ;; reduce "... ( x )" --> "... x" | |
1200 (setq calculator-stack | |
1201 (cons (nth 1 calculator-stack) | |
1202 (nthcdr 3 calculator-stack))) | |
1203 ;; another iteration | |
1204 t) | |
1205 ((and (cdr (cdr calculator-stack)) ; have three values | |
1206 (numberp (nth 0 calculator-stack)) ; two nums & operator | |
1207 (consp (nth 1 calculator-stack)) | |
1208 (numberp (nth 2 calculator-stack)) | |
1209 (= 2 (calculator-op-arity ; binary operator | |
1210 (nth 1 calculator-stack))) | |
1211 (<= prec ; with higher prec. | |
1212 (calculator-op-prec (nth 1 calculator-stack)))) | |
1213 ;; reduce "... x op y" --> "... r", r is the result | |
1214 (setq calculator-stack | |
1215 (cons (calculator-funcall | |
1216 (nth 2 (nth 1 calculator-stack)) | |
1217 (nth 2 calculator-stack) | |
1218 (nth 0 calculator-stack)) | |
1219 (nthcdr 3 calculator-stack))) | |
1220 ;; another iteration | |
1221 t) | |
1222 ((and (>= (length calculator-stack) 2) ; have two values | |
1223 (numberp (nth 0 calculator-stack)) ; number & operator | |
1224 (consp (nth 1 calculator-stack)) | |
1225 (= -1 (calculator-op-arity ; prefix-unary op | |
1226 (nth 1 calculator-stack))) | |
1227 (<= prec ; with higher prec. | |
1228 (calculator-op-prec (nth 1 calculator-stack)))) | |
1229 ;; reduce "... op x" --> "... r" for prefix op | |
1230 (setq calculator-stack | |
1231 (cons (calculator-funcall | |
1232 (nth 2 (nth 1 calculator-stack)) | |
1233 (nth 0 calculator-stack)) | |
1234 (nthcdr 2 calculator-stack))) | |
1235 ;; another iteration | |
1236 t) | |
1237 ((and (cdr calculator-stack) ; have two values | |
1238 (consp (nth 0 calculator-stack)) ; operator & number | |
1239 (numberp (nth 1 calculator-stack)) | |
1240 (= +1 (calculator-op-arity ; postfix-unary op | |
1241 (nth 0 calculator-stack))) | |
1242 (<= prec ; with higher prec. | |
1243 (calculator-op-prec (nth 0 calculator-stack)))) | |
1244 ;; reduce "... x op" --> "... r" for postfix op | |
1245 (setq calculator-stack | |
1246 (cons (calculator-funcall | |
1247 (nth 2 (nth 0 calculator-stack)) | |
1248 (nth 1 calculator-stack)) | |
1249 (nthcdr 2 calculator-stack))) | |
1250 ;; another iteration | |
1251 t) | |
1252 ((and calculator-stack ; have one value | |
1253 (consp (nth 0 calculator-stack)) ; an operator | |
1254 (= 0 (calculator-op-arity ; 0-ary op | |
1255 (nth 0 calculator-stack)))) | |
1256 ;; reduce "... op" --> "... r" for 0-ary op | |
1257 (setq calculator-stack | |
1258 (cons (calculator-funcall | |
1259 (nth 2 (nth 0 calculator-stack))) | |
1260 (nthcdr 1 calculator-stack))) | |
1261 ;; another iteration | |
1262 t) | |
1263 ((and (cdr calculator-stack) ; have two values | |
1264 (numberp (nth 0 calculator-stack)) ; both numbers | |
1265 (numberp (nth 1 calculator-stack))) | |
1266 ;; get rid of redundant numbers: | |
1267 ;; reduce "... y x" --> "... x" | |
1268 ;; needed for 0-ary ops that puts more values | |
1269 (setcdr calculator-stack (cdr (cdr calculator-stack)))) | |
1270 (t ;; no more iterations | |
1271 nil)))) | |
1272 | |
33491 | 1273 (defun calculator-funcall (f &optional X Y) |
1274 "If F is a symbol, evaluate (F X Y). | |
1275 Otherwise, it should be a list, evaluate it with X, Y bound to the | |
1276 arguments." | |
1277 ;; remember binary ops for calculator-repR/L | |
1278 (if Y (setq calculator-last-opXY (list f X Y))) | |
1279 (condition-case nil | |
1280 ;; there used to be code here that returns 0 if the result was | |
1281 ;; smaller than calculator-epsilon (1e-15). I don't think this is | |
1282 ;; necessary now. | |
1283 (if (symbolp f) | |
1284 (cond ((and X Y) (funcall f X Y)) | |
1285 (X (funcall f X)) | |
1286 (t (funcall f))) | |
1287 ;; f is an expression | |
1288 (let* ((__f__ f) ; so we can get this value below... | |
1289 (TX (calculator-truncate X)) | |
1290 (TY (and Y (calculator-truncate Y))) | |
1291 (DX (if calculator-deg (/ (* X pi) 180) X)) | |
1292 (L calculator-saved-list) | |
1293 (Fbound (fboundp 'F)) | |
1294 (Fsave (and Fbound (symbol-function 'F))) | |
1295 (Dbound (fboundp 'D)) | |
1296 (Dsave (and Dbound (symbol-function 'D)))) | |
1297 ;; a shortened version of flet | |
1298 (fset 'F (function | |
1299 (lambda (&optional x y) | |
1300 (calculator-funcall __f__ x y)))) | |
1301 (fset 'D (function | |
1302 (lambda (x) | |
1303 (if calculator-deg (/ (* x 180) pi) x)))) | |
1304 (unwind-protect (eval f) | |
1305 (if Fbound (fset 'F Fsave) (fmakunbound 'F)) | |
1306 (if Dbound (fset 'D Dsave) (fmakunbound 'D))))) | |
1307 (error 0))) | |
1308 | |
33631 | 1309 ;;;--------------------------------------------------------------------- |
33491 | 1310 ;;; Input interaction |
1311 | |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
1312 (defun calculator-last-input (&optional keys) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
1313 "Last char (or event or event sequence) that was read. |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
1314 Optional string argument KEYS will force using it as the keys entered." |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
1315 (let ((inp (or keys (this-command-keys)))) |
27587 | 1316 (if (or (stringp inp) (not (arrayp inp))) |
1317 inp | |
1318 ;; this translates kp-x to x and [tries to] create a string to | |
1319 ;; lookup operators | |
1320 (let* ((i -1) (converted-str (make-string (length inp) ? )) k) | |
1321 ;; converts an array to a string the ops lookup with keypad | |
1322 ;; input | |
1323 (while (< (setq i (1+ i)) (length inp)) | |
1324 (setq k (aref inp i)) | |
1325 ;; if Emacs will someday have a event-key, then this would | |
1326 ;; probably be modified anyway | |
64381
c25db06be8ca
(calculator-last-input): Guard uses of event-key and key-press-event-p.
Richard M. Stallman <rms@gnu.org>
parents:
64091
diff
changeset
|
1327 (and (if (fboundp 'key-press-event-p) (key-press-event-p k)) |
c25db06be8ca
(calculator-last-input): Guard uses of event-key and key-press-event-p.
Richard M. Stallman <rms@gnu.org>
parents:
64091
diff
changeset
|
1328 (if (fboundp 'event-key) |
c25db06be8ca
(calculator-last-input): Guard uses of event-key and key-press-event-p.
Richard M. Stallman <rms@gnu.org>
parents:
64091
diff
changeset
|
1329 (and (event-key k) (setq k (event-key k))))) |
27587 | 1330 ;; assume all symbols are translatable with an ascii-character |
1331 (and (symbolp k) | |
1332 (setq k (or (get k 'ascii-character) ? ))) | |
1333 (aset converted-str i k)) | |
1334 converted-str)))) | |
1335 | |
1336 (defun calculator-clear-fragile (&optional op) | |
1337 "Clear the fragile flag if it was set, then maybe reset all. | |
1338 OP is the operator (if any) that caused this call." | |
1339 (if (and calculator-display-fragile | |
1340 (or (not op) | |
1341 (= -1 (calculator-op-arity op)) | |
1342 (= 0 (calculator-op-arity op)))) | |
1343 ;; reset if last calc finished, and now get a num or prefix or 0-ary | |
33491 | 1344 ;; op |
27587 | 1345 (calculator-reset)) |
1346 (setq calculator-display-fragile nil)) | |
1347 | |
1348 (defun calculator-digit () | |
1349 "Enter a single digit." | |
1350 (interactive) | |
1351 (let ((inp (aref (calculator-last-input) 0))) | |
1352 (if (and (or calculator-display-fragile | |
1353 (not (numberp (car calculator-stack)))) | |
1354 (cond | |
1355 ((not calculator-input-radix) (<= inp ?9)) | |
1356 ((eq calculator-input-radix 'bin) (<= inp ?1)) | |
1357 ((eq calculator-input-radix 'oct) (<= inp ?7)) | |
1358 (t t))) | |
1359 ;; enter digit if starting a new computation or have an op on the | |
33491 | 1360 ;; stack |
27587 | 1361 (progn |
1362 (calculator-clear-fragile) | |
1363 (let ((digit (upcase (char-to-string inp)))) | |
1364 (if (equal calculator-curnum "0") | |
1365 (setq calculator-curnum nil)) | |
1366 (setq calculator-curnum | |
1367 (concat (or calculator-curnum "") digit))) | |
1368 (calculator-update-display))))) | |
1369 | |
1370 (defun calculator-decimal () | |
1371 "Enter a decimal period." | |
1372 (interactive) | |
1373 (if (and (not calculator-input-radix) | |
1374 (or calculator-display-fragile | |
1375 (not (numberp (car calculator-stack)))) | |
1376 (not (and calculator-curnum | |
1377 (string-match "[.eE]" calculator-curnum)))) | |
1378 ;; enter the period on the same condition as a digit, only if no | |
33491 | 1379 ;; period or exponent entered yet |
27587 | 1380 (progn |
1381 (calculator-clear-fragile) | |
1382 (setq calculator-curnum (concat (or calculator-curnum "0") ".")) | |
1383 (calculator-update-display)))) | |
1384 | |
1385 (defun calculator-exp () | |
1386 "Enter an `E' exponent character, or a digit in hex input mode." | |
1387 (interactive) | |
1388 (if calculator-input-radix | |
1389 (calculator-digit) | |
1390 (if (and (or calculator-display-fragile | |
1391 (not (numberp (car calculator-stack)))) | |
1392 (not (and calculator-curnum | |
1393 (string-match "[eE]" calculator-curnum)))) | |
33491 | 1394 ;; same condition as above, also no E so far |
27587 | 1395 (progn |
1396 (calculator-clear-fragile) | |
1397 (setq calculator-curnum (concat (or calculator-curnum "1") "e")) | |
1398 (calculator-update-display))))) | |
1399 | |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
1400 (defun calculator-op (&optional keys) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
1401 "Enter an operator on the stack, doing all necessary reductions. |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
1402 Optional string argument KEYS will force using it as the keys entered." |
27587 | 1403 (interactive) |
33491 | 1404 (catch 'op-error |
1405 (let* ((last-inp (calculator-last-input keys)) | |
1406 (op (assoc last-inp calculator-operators))) | |
1407 (calculator-clear-fragile op) | |
1408 (if (and calculator-curnum (/= (calculator-op-arity op) 0)) | |
1409 (setq calculator-stack | |
1410 (cons (calculator-curnum-value) calculator-stack))) | |
1411 (setq calculator-curnum nil) | |
1412 (if (and (= 2 (calculator-op-arity op)) | |
1413 (not (and calculator-stack | |
1414 (numberp (nth 0 calculator-stack))))) | |
1415 ;; we have a binary operator but no number - search for a prefix | |
1416 ;; version | |
1417 (let ((rest-ops calculator-operators)) | |
1418 (while (not (equal last-inp (car (car rest-ops)))) | |
1419 (setq rest-ops (cdr rest-ops))) | |
1420 (setq op (assoc last-inp (cdr rest-ops))) | |
1421 (if (not (and op (= -1 (calculator-op-arity op)))) | |
1422 ;;(error "Binary operator without a first operand") | |
1423 (progn | |
59056
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
1424 (calculator-message |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
1425 "Binary operator without a first operand") |
33491 | 1426 (throw 'op-error nil))))) |
1427 (calculator-reduce-stack | |
1428 (cond ((eq (nth 1 op) '\() 10) | |
1429 ((eq (nth 1 op) '\)) 0) | |
1430 (t (calculator-op-prec op)))) | |
1431 (if (or (and (= -1 (calculator-op-arity op)) | |
1432 (numberp (car calculator-stack))) | |
1433 (and (/= (calculator-op-arity op) -1) | |
1434 (/= (calculator-op-arity op) 0) | |
1435 (not (numberp (car calculator-stack))))) | |
1436 ;;(error "Unterminated expression") | |
1437 (progn | |
59056
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
1438 (calculator-message "Unterminated expression") |
33491 | 1439 (throw 'op-error nil))) |
1440 (setq calculator-stack (cons op calculator-stack)) | |
1441 (calculator-reduce-stack (calculator-op-prec op)) | |
1442 (and (= (length calculator-stack) 1) | |
1443 (numberp (nth 0 calculator-stack)) | |
1444 ;; the display is fragile if it contains only one number | |
1445 (setq calculator-display-fragile t) | |
1446 ;; add number to the saved-list | |
1447 calculator-add-saved | |
1448 (if (= 0 calculator-saved-ptr) | |
1449 (setq calculator-saved-list | |
1450 (cons (car calculator-stack) calculator-saved-list)) | |
1451 (let ((p (nthcdr (1- calculator-saved-ptr) | |
1452 calculator-saved-list))) | |
1453 (setcdr p (cons (car calculator-stack) (cdr p)))))) | |
1454 (calculator-update-display)))) | |
27587 | 1455 |
1456 (defun calculator-op-or-exp () | |
1457 "Either enter an operator or a digit. | |
33491 | 1458 Used with +/- for entering them as digits in numbers like 1e-3 (there is |
99899
2796739a5e4f
* calculator.el (calculator-op-or-exp): Reflow docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
94680
diff
changeset
|
1459 no need for negative numbers since these are handled by unary operators)." |
27587 | 1460 (interactive) |
1461 (if (and (not calculator-display-fragile) | |
1462 calculator-curnum | |
1463 (string-match "[eE]$" calculator-curnum)) | |
1464 (calculator-digit) | |
1465 (calculator-op))) | |
1466 | |
33631 | 1467 ;;;--------------------------------------------------------------------- |
33491 | 1468 ;;; Input/output modes (not display) |
1469 | |
27587 | 1470 (defun calculator-dec/deg-mode () |
1471 "Set decimal mode for display & input, if decimal, toggle deg mode." | |
1472 (interactive) | |
1473 (if calculator-curnum | |
1474 (setq calculator-stack | |
1475 (cons (calculator-curnum-value) calculator-stack))) | |
1476 (setq calculator-curnum nil) | |
1477 (if (or calculator-input-radix calculator-output-radix) | |
1478 (progn (setq calculator-input-radix nil) | |
1479 (setq calculator-output-radix nil)) | |
1480 ;; already decimal - toggle degrees mode | |
1481 (setq calculator-deg (not calculator-deg))) | |
1482 (calculator-update-display t)) | |
1483 | |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
1484 (defun calculator-radix-mode (&optional keys) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
1485 "Set input and display radix modes. |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
1486 Optional string argument KEYS will force using it as the keys entered." |
27587 | 1487 (interactive) |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
1488 (calculator-radix-input-mode keys) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
1489 (calculator-radix-output-mode keys)) |
27587 | 1490 |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
1491 (defun calculator-radix-input-mode (&optional keys) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
1492 "Set input radix modes. |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
1493 Optional string argument KEYS will force using it as the keys entered." |
27587 | 1494 (interactive) |
1495 (if calculator-curnum | |
1496 (setq calculator-stack | |
1497 (cons (calculator-curnum-value) calculator-stack))) | |
1498 (setq calculator-curnum nil) | |
1499 (setq calculator-input-radix | |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
1500 (let ((inp (calculator-last-input keys))) |
27587 | 1501 (cdr (assq (upcase (aref inp (1- (length inp)))) |
1502 calculator-char-radix)))) | |
1503 (calculator-update-display)) | |
1504 | |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
1505 (defun calculator-radix-output-mode (&optional keys) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
1506 "Set display radix modes. |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
1507 Optional string argument KEYS will force using it as the keys entered." |
27587 | 1508 (interactive) |
1509 (if calculator-curnum | |
1510 (setq calculator-stack | |
1511 (cons (calculator-curnum-value) calculator-stack))) | |
1512 (setq calculator-curnum nil) | |
1513 (setq calculator-output-radix | |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
1514 (let ((inp (calculator-last-input keys))) |
27587 | 1515 (cdr (assq (upcase (aref inp (1- (length inp)))) |
1516 calculator-char-radix)))) | |
1517 (calculator-update-display t)) | |
1518 | |
33631 | 1519 ;;;--------------------------------------------------------------------- |
33491 | 1520 ;;; Saved values list |
1521 | |
27587 | 1522 (defun calculator-save-on-list () |
1523 "Evaluate current expression, put result on the saved values list." | |
1524 (interactive) | |
1525 (let ((calculator-add-saved t)) ; marks the result to be added | |
1526 (calculator-enter))) | |
1527 | |
1528 (defun calculator-clear-saved () | |
1529 "Clear the list of saved values in `calculator-saved-list'." | |
1530 (interactive) | |
1531 (setq calculator-saved-list nil) | |
33491 | 1532 (setq calculator-saved-ptr 0) |
27587 | 1533 (calculator-update-display t)) |
1534 | |
1535 (defun calculator-saved-move (n) | |
1536 "Go N elements up the list of saved values." | |
1537 (interactive) | |
1538 (and calculator-saved-list | |
1539 (or (null calculator-stack) calculator-display-fragile) | |
1540 (progn | |
1541 (setq calculator-saved-ptr | |
1542 (max (min (+ n calculator-saved-ptr) | |
1543 (length calculator-saved-list)) | |
1544 0)) | |
1545 (if (nth calculator-saved-ptr calculator-saved-list) | |
1546 (setq calculator-stack | |
1547 (list (nth calculator-saved-ptr calculator-saved-list)) | |
1548 calculator-display-fragile t) | |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
1549 (calculator-reset)) |
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
1550 (calculator-update-display)))) |
27587 | 1551 |
1552 (defun calculator-saved-up () | |
1553 "Go up the list of saved values." | |
1554 (interactive) | |
1555 (calculator-saved-move +1)) | |
1556 | |
1557 (defun calculator-saved-down () | |
1558 "Go down the list of saved values." | |
1559 (interactive) | |
1560 (calculator-saved-move -1)) | |
1561 | |
33631 | 1562 ;;;--------------------------------------------------------------------- |
33491 | 1563 ;;; Misc functions |
1564 | |
27587 | 1565 (defun calculator-open-paren () |
1566 "Equivalents of `(' use this." | |
1567 (interactive) | |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
1568 (calculator-op "(")) |
27587 | 1569 |
1570 (defun calculator-close-paren () | |
1571 "Equivalents of `)' use this." | |
1572 (interactive) | |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
1573 (calculator-op ")")) |
27587 | 1574 |
1575 (defun calculator-enter () | |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
1576 "Evaluate current expression." |
27587 | 1577 (interactive) |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
1578 (calculator-op "=")) |
27587 | 1579 |
1580 (defun calculator-backspace () | |
1581 "Backward delete a single digit or a stack element." | |
1582 (interactive) | |
1583 (if calculator-curnum | |
1584 (setq calculator-curnum | |
1585 (if (> (length calculator-curnum) 1) | |
1586 (substring calculator-curnum | |
1587 0 (1- (length calculator-curnum))) | |
1588 nil)) | |
1589 (setq calculator-stack (cdr calculator-stack))) | |
1590 (calculator-update-display)) | |
1591 | |
1592 (defun calculator-clear () | |
1593 "Clear current number." | |
1594 (interactive) | |
1595 (setq calculator-curnum nil) | |
1596 (cond | |
1597 ;; if the current number is from the saved-list - remove it | |
1598 ((and calculator-display-fragile | |
1599 calculator-saved-list | |
1600 (= (car calculator-stack) | |
1601 (nth calculator-saved-ptr calculator-saved-list))) | |
1602 (if (= 0 calculator-saved-ptr) | |
1603 (setq calculator-saved-list (cdr calculator-saved-list)) | |
1604 (let ((p (nthcdr (1- calculator-saved-ptr) | |
1605 calculator-saved-list))) | |
1606 (setcdr p (cdr (cdr p))) | |
1607 (setq calculator-saved-ptr (1- calculator-saved-ptr)))) | |
1608 (if calculator-saved-list | |
1609 (setq calculator-stack | |
1610 (list (nth calculator-saved-ptr calculator-saved-list))) | |
1611 (calculator-reset))) | |
1612 ;; reset if fragile or double clear | |
1613 ((or calculator-display-fragile (eq last-command this-command)) | |
1614 (calculator-reset))) | |
1615 (calculator-update-display)) | |
1616 | |
1617 (defun calculator-copy () | |
1618 "Copy current number to the `kill-ring'." | |
1619 (interactive) | |
39430
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1620 (let ((calculator-displayer |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1621 (or calculator-copy-displayer calculator-displayer)) |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1622 (calculator-displayers |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1623 (if calculator-copy-displayer nil calculator-displayers))) |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1624 (calculator-enter) |
64440
41bfd05eff2a
(calculator-copy): Delete duplicate words.
Juri Linkov <juri@jurta.org>
parents:
64381
diff
changeset
|
1625 ;; remove trailing spaces and an index |
39430
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1626 (let ((s (cdr calculator-stack-display))) |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1627 (and s |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1628 (if (string-match "^\\([^ ]+\\) *\\(\\[[0-9/]+\\]\\)? *$" s) |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1629 (setq s (match-string 1 s))) |
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1630 (kill-new s))))) |
27587 | 1631 |
1632 (defun calculator-set-register (reg) | |
1633 "Set a register value for REG." | |
1634 (interactive "cRegister to store into: ") | |
1635 (let* ((as (assq reg calculator-registers)) | |
1636 (val (progn (calculator-enter) (car calculator-stack)))) | |
1637 (if as | |
1638 (setcdr as val) | |
1639 (setq calculator-registers | |
1640 (cons (cons reg val) calculator-registers))) | |
59056
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
1641 (calculator-message "[%c] := %S" reg val))) |
27587 | 1642 |
1643 (defun calculator-put-value (val) | |
1644 "Paste VAL as if entered. | |
1645 Used by `calculator-paste' and `get-register'." | |
1646 (if (and (numberp val) | |
1647 ;; (not calculator-curnum) | |
1648 (or calculator-display-fragile | |
1649 (not (numberp (car calculator-stack))))) | |
1650 (progn | |
1651 (calculator-clear-fragile) | |
39430
48633cf4ce7c
(calculator-copy-displayer): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents:
38436
diff
changeset
|
1652 (setq calculator-curnum (let ((calculator-displayer "%S")) |
59056
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
1653 (calculator-number-to-string val))) |
27587 | 1654 (calculator-update-display)))) |
1655 | |
1656 (defun calculator-paste () | |
1657 "Paste a value from the `kill-ring'." | |
1658 (interactive) | |
1659 (calculator-put-value | |
59056
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
1660 (let ((str (replace-regexp-in-string |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
1661 "^ *\\(.+[^ ]\\) *$" "\\1" (current-kill 0)))) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
1662 (and (not calculator-input-radix) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
1663 calculator-paste-decimals |
33631 | 1664 (string-match "\\([0-9]+\\)\\(\\.[0-9]+\\)?\\(e[0-9]+\\)?" |
1665 str) | |
1666 (or (match-string 1 str) | |
1667 (match-string 2 str) | |
1668 (match-string 3 str)) | |
59056
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
1669 (setq str (concat (or (match-string 1 str) "0") |
33631 | 1670 (or (match-string 2 str) ".0") |
59056
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
1671 (or (match-string 3 str) "")))) |
956483cc3659
(calculator-radix-grouping-mode)
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
1672 (condition-case nil (calculator-string-to-number str) |
33491 | 1673 (error nil))))) |
27587 | 1674 |
1675 (defun calculator-get-register (reg) | |
1676 "Get a value from a register REG." | |
1677 (interactive "cRegister to get value from: ") | |
1678 (calculator-put-value (cdr (assq reg calculator-registers)))) | |
1679 | |
1680 (defun calculator-help () | |
1681 ;; this is used as the quick reference screen you get with `h' | |
1682 "Quick reference: | |
1683 * numbers/operators/parens/./e - enter expressions | |
1684 + - * / \\(div) %(rem) _(-X,postfix) ;(1/X,postfix) ^(exp) L(og) | |
1685 Q(sqrt) !(fact) S(in) C(os) T(an) |(or) #(xor) &(and) ~(not) | |
1686 * >/< repeats last binary operation with its 2nd (1st) arg as postfix op | |
33491 | 1687 * I inverses next trig function * '/\"/{} - display/display args |
1688 * D - switch to all-decimal, or toggle deg/rad mode | |
27587 | 1689 * B/O/H/X - binary/octal/hex mode for i/o (X is a shortcut for H) |
1690 * i/o - prefix for d/b/o/x - set only input/output modes | |
1691 * enter/= - evaluate current expr. * s/g - set/get a register | |
1692 * space - evaluate & save on list * l/v - list total/average | |
1693 * up/down/C-p/C-n - browse saved * C-delete - clear all saved | |
27904
af501f05394a
(calculator-use-menu): New option.
Gerd Moellmann <gerd@gnu.org>
parents:
27587
diff
changeset
|
1694 * C-insert - copy whole expr. * C-return - evaluate, copy, exit |
27587 | 1695 * insert - paste a number * backspace- delete backwards |
1696 * delete - clear argument or list value or whole expression (twice) | |
1697 * escape/q - exit." | |
1698 (interactive) | |
1699 (if (eq last-command 'calculator-help) | |
1700 (let ((mode-name "Calculator") | |
1701 (major-mode 'calculator-mode) | |
1702 (g-map (current-global-map)) | |
1703 (win (selected-window))) | |
1704 (require 'ehelp) | |
1705 (if calculator-electric-mode | |
1706 (use-global-map calculator-saved-global-map)) | |
33631 | 1707 (if (or (not calculator-electric-mode) |
1708 ;; XEmacs has a problem with electric-describe-mode | |
85511
f873840f9fea
* emulation/edt-mapper.el (function-key-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
83794
diff
changeset
|
1709 (featurep 'xemacs)) |
33631 | 1710 (describe-mode) |
1711 (electric-describe-mode)) | |
27587 | 1712 (if calculator-electric-mode |
1713 (use-global-map g-map)) | |
1714 (select-window win) ; these are for XEmacs (also below) | |
1715 (message nil)) | |
1716 (let ((one (one-window-p t)) | |
1717 (win (selected-window)) | |
1718 (help-buf (get-buffer-create "*Help*"))) | |
1719 (save-window-excursion | |
1720 (with-output-to-temp-buffer "*Help*" | |
1721 (princ (documentation 'calculator-help))) | |
1722 (if one | |
1723 (shrink-window-if-larger-than-buffer | |
1724 (get-buffer-window help-buf))) | |
1725 (message | |
1726 "`%s' again for more help, any other key continues normally." | |
1727 (calculator-last-input)) | |
1728 (select-window win) | |
1729 (sit-for 360)) | |
1730 (select-window win)))) | |
1731 | |
1732 (defun calculator-quit () | |
1733 "Quit calculator." | |
1734 (interactive) | |
1735 (set-buffer calculator-buffer) | |
1736 (let ((inhibit-read-only t)) (erase-buffer)) | |
1737 (if (not calculator-electric-mode) | |
1738 (progn | |
1739 (condition-case nil | |
1740 (while (get-buffer-window calculator-buffer) | |
1741 (delete-window (get-buffer-window calculator-buffer))) | |
1742 (error nil)) | |
1743 (kill-buffer calculator-buffer))) | |
1744 (setq calculator-buffer nil) | |
1745 (message "Calculator done.") | |
1746 (if calculator-electric-mode (throw 'calculator-done nil))) | |
1747 | |
1748 (defun calculator-save-and-quit () | |
1749 "Quit the calculator, saving the result on the `kill-ring'." | |
1750 (interactive) | |
1751 (calculator-enter) | |
1752 (calculator-copy) | |
1753 (calculator-quit)) | |
1754 | |
1755 (defun calculator-repR (x) | |
99899
2796739a5e4f
* calculator.el (calculator-op-or-exp): Reflow docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
94680
diff
changeset
|
1756 "Repeat the last binary operation with its second argument and X. |
27587 | 1757 To use this, apply a binary operator (evaluate it), then call this." |
1758 (if calculator-last-opXY | |
1759 ;; avoid rebinding calculator-last-opXY | |
1760 (let ((calculator-last-opXY calculator-last-opXY)) | |
1761 (calculator-funcall | |
1762 (car calculator-last-opXY) x (nth 2 calculator-last-opXY))) | |
1763 x)) | |
1764 | |
1765 (defun calculator-repL (x) | |
99899
2796739a5e4f
* calculator.el (calculator-op-or-exp): Reflow docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
94680
diff
changeset
|
1766 "Repeat the last binary operation with its first argument and X. |
27587 | 1767 To use this, apply a binary operator (evaluate it), then call this." |
1768 (if calculator-last-opXY | |
1769 ;; avoid rebinding calculator-last-opXY | |
1770 (let ((calculator-last-opXY calculator-last-opXY)) | |
1771 (calculator-funcall | |
1772 (car calculator-last-opXY) (nth 1 calculator-last-opXY) x)) | |
1773 x)) | |
1774 | |
81696
c29faa83ba3a
(calculator-expt, calculator-integer-p): New functions.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75773
diff
changeset
|
1775 (defun calculator-integer-p (x) |
c29faa83ba3a
(calculator-expt, calculator-integer-p): New functions.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75773
diff
changeset
|
1776 "Non-nil if X is equal to an integer." |
c29faa83ba3a
(calculator-expt, calculator-integer-p): New functions.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75773
diff
changeset
|
1777 (condition-case nil |
c29faa83ba3a
(calculator-expt, calculator-integer-p): New functions.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75773
diff
changeset
|
1778 (= x (ftruncate x)) |
c29faa83ba3a
(calculator-expt, calculator-integer-p): New functions.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75773
diff
changeset
|
1779 (error nil))) |
c29faa83ba3a
(calculator-expt, calculator-integer-p): New functions.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75773
diff
changeset
|
1780 |
c29faa83ba3a
(calculator-expt, calculator-integer-p): New functions.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75773
diff
changeset
|
1781 (defun calculator-expt (x y) |
c29faa83ba3a
(calculator-expt, calculator-integer-p): New functions.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75773
diff
changeset
|
1782 "Compute X^Y, dealing with errors appropriately." |
c29faa83ba3a
(calculator-expt, calculator-integer-p): New functions.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75773
diff
changeset
|
1783 (condition-case |
c29faa83ba3a
(calculator-expt, calculator-integer-p): New functions.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75773
diff
changeset
|
1784 nil |
c29faa83ba3a
(calculator-expt, calculator-integer-p): New functions.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75773
diff
changeset
|
1785 (expt x y) |
c29faa83ba3a
(calculator-expt, calculator-integer-p): New functions.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75773
diff
changeset
|
1786 (domain-error 0.0e+NaN) |
c29faa83ba3a
(calculator-expt, calculator-integer-p): New functions.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75773
diff
changeset
|
1787 (range-error |
81700
a92fa56df453
(calculator-expt): Use more cases to determine the value.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81696
diff
changeset
|
1788 (cond |
a92fa56df453
(calculator-expt): Use more cases to determine the value.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81696
diff
changeset
|
1789 ((and (< x 1.0) (> x -1.0)) |
a92fa56df453
(calculator-expt): Use more cases to determine the value.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81696
diff
changeset
|
1790 ;; For small x, the range error comes from large y. |
a92fa56df453
(calculator-expt): Use more cases to determine the value.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81696
diff
changeset
|
1791 0.0) |
a92fa56df453
(calculator-expt): Use more cases to determine the value.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81696
diff
changeset
|
1792 ((and (> x 0.0) (< y 0.0)) |
94389
c8cc1acc029f
(calculator-expt): Modify previous change to just use the expanded cl
Glenn Morris <rgm@gnu.org>
parents:
94388
diff
changeset
|
1793 ;; For large positive x and negative y, the range error |
81700
a92fa56df453
(calculator-expt): Use more cases to determine the value.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81696
diff
changeset
|
1794 ;; comes from large negative y. |
a92fa56df453
(calculator-expt): Use more cases to determine the value.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81696
diff
changeset
|
1795 0.0) |
a92fa56df453
(calculator-expt): Use more cases to determine the value.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81696
diff
changeset
|
1796 ((and (> x 0.0) (> y 0.0)) |
94389
c8cc1acc029f
(calculator-expt): Modify previous change to just use the expanded cl
Glenn Morris <rgm@gnu.org>
parents:
94388
diff
changeset
|
1797 ;; For large positive x and positive y, the range error |
81700
a92fa56df453
(calculator-expt): Use more cases to determine the value.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81696
diff
changeset
|
1798 ;; comes from large y. |
a92fa56df453
(calculator-expt): Use more cases to determine the value.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81696
diff
changeset
|
1799 1.0e+INF) |
a92fa56df453
(calculator-expt): Use more cases to determine the value.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81696
diff
changeset
|
1800 ;; For the rest, x must be large and negative. |
a92fa56df453
(calculator-expt): Use more cases to determine the value.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81696
diff
changeset
|
1801 ;; The range errors come from large integer y. |
a92fa56df453
(calculator-expt): Use more cases to determine the value.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81696
diff
changeset
|
1802 ((< y 0.0) |
a92fa56df453
(calculator-expt): Use more cases to determine the value.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81696
diff
changeset
|
1803 0.0) |
94389
c8cc1acc029f
(calculator-expt): Modify previous change to just use the expanded cl
Glenn Morris <rgm@gnu.org>
parents:
94388
diff
changeset
|
1804 ((eq (logand (truncate y) 1) 1) ; expansion of cl `oddp' |
81700
a92fa56df453
(calculator-expt): Use more cases to determine the value.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81696
diff
changeset
|
1805 ;; If y is odd |
a92fa56df453
(calculator-expt): Use more cases to determine the value.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81696
diff
changeset
|
1806 -1.0e+INF) |
a92fa56df453
(calculator-expt): Use more cases to determine the value.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81696
diff
changeset
|
1807 (t |
99899
2796739a5e4f
* calculator.el (calculator-op-or-exp): Reflow docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
94680
diff
changeset
|
1808 ;; |
81700
a92fa56df453
(calculator-expt): Use more cases to determine the value.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81696
diff
changeset
|
1809 1.0e+INF))) |
81696
c29faa83ba3a
(calculator-expt, calculator-integer-p): New functions.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75773
diff
changeset
|
1810 (error 0.0e+NaN))) |
c29faa83ba3a
(calculator-expt, calculator-integer-p): New functions.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75773
diff
changeset
|
1811 |
27587 | 1812 (defun calculator-fact (x) |
1813 "Simple factorial of X." | |
81696
c29faa83ba3a
(calculator-expt, calculator-integer-p): New functions.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75773
diff
changeset
|
1814 (if (and (>= x 0) |
c29faa83ba3a
(calculator-expt, calculator-integer-p): New functions.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75773
diff
changeset
|
1815 (calculator-integer-p x)) |
c29faa83ba3a
(calculator-expt, calculator-integer-p): New functions.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75773
diff
changeset
|
1816 (if (= (calculator-expt (/ x 3.0) x) 1.0e+INF) |
c29faa83ba3a
(calculator-expt, calculator-integer-p): New functions.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75773
diff
changeset
|
1817 1.0e+INF |
c29faa83ba3a
(calculator-expt, calculator-integer-p): New functions.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75773
diff
changeset
|
1818 (let ((r (if (<= x 10) 1 1.0))) |
c29faa83ba3a
(calculator-expt, calculator-integer-p): New functions.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75773
diff
changeset
|
1819 (while (> x 0) |
c29faa83ba3a
(calculator-expt, calculator-integer-p): New functions.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75773
diff
changeset
|
1820 (setq r (* r (truncate x))) |
c29faa83ba3a
(calculator-expt, calculator-integer-p): New functions.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75773
diff
changeset
|
1821 (setq x (1- x))) |
c29faa83ba3a
(calculator-expt, calculator-integer-p): New functions.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75773
diff
changeset
|
1822 (+ 0.0 r))) |
c29faa83ba3a
(calculator-expt, calculator-integer-p): New functions.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75773
diff
changeset
|
1823 (if (= x 1.0e+INF) |
c29faa83ba3a
(calculator-expt, calculator-integer-p): New functions.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75773
diff
changeset
|
1824 x |
c29faa83ba3a
(calculator-expt, calculator-integer-p): New functions.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
75773
diff
changeset
|
1825 0.0e+NaN))) |
27587 | 1826 |
1827 (defun calculator-truncate (n) | |
1828 "Truncate N, return 0 in case of overflow." | |
1829 (condition-case nil (truncate n) (error 0))) | |
1830 | |
1831 | |
1832 (provide 'calculator) | |
1833 | |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87649
diff
changeset
|
1834 ;; arch-tag: a1b9766c-af8a-4a74-b466-65ad8eeb0c73 |
27587 | 1835 ;;; calculator.el ends here |