Mercurial > emacs
annotate lisp/calc/calc-macs.el @ 40945:37f2fe9b6ad0
(toplevel): Bind mouse buttons.
(calc-do-keypad): Don't attempt to use nonexistent global
mouse-map, use calc-keypad-map.
(calc-keypad-x-left-click): Renamed to calc-keypad-left-click.
(calc-keypad-left-click): Don't use mouse-map; update to new event
interface.
(calc-keypad-x-middle-click, calc-keypad-x-right-click): Ditto.
(calc-keypad-press): Use `unread-command-events' instead of
`unread-command-char'.
author | Eli Zaretskii <eliz@gnu.org> |
---|---|
date | Mon, 12 Nov 2001 11:39:45 +0000 |
parents | c07c0f7a2c8e |
children | 73f364fd8aaa |
rev | line source |
---|---|
40785 | 1 ;; Calculator for GNU Emacs, part I [calc-macs.el] |
2 ;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. | |
3 ;; Written by Dave Gillespie, daveg@synaptics.com. | |
4 | |
5 ;; This file is part of GNU Emacs. | |
6 | |
7 ;; GNU Emacs is distributed in the hope that it will be useful, | |
8 ;; but WITHOUT ANY WARRANTY. No author or distributor | |
9 ;; accepts responsibility to anyone for the consequences of using it | |
10 ;; or for whether it serves any particular purpose or works at all, | |
11 ;; unless he says so in writing. Refer to the GNU Emacs General Public | |
12 ;; License for full details. | |
13 | |
14 ;; Everyone is granted permission to copy, modify and redistribute | |
15 ;; GNU Emacs, but only under the conditions described in the | |
16 ;; GNU Emacs General Public License. A copy of this license is | |
17 ;; supposed to have been given to you along with GNU Emacs so you | |
18 ;; can know your rights and responsibilities. It should be in a | |
19 ;; file named COPYING. Among other things, the copyright notice | |
20 ;; and this notice must be preserved on all copies. | |
21 | |
22 | |
23 (provide 'calc-macs) | |
24 | |
25 (defun calc-need-macros () nil) | |
26 | |
27 | |
28 (defmacro calc-record-compilation-date-macro () | |
40910
c07c0f7a2c8e
(calc-record-compilation-date-macro): Return a
Eli Zaretskii <eliz@gnu.org>
parents:
40785
diff
changeset
|
29 `(setq calc-installed-date ,(concat (current-time-string) |
c07c0f7a2c8e
(calc-record-compilation-date-macro): Return a
Eli Zaretskii <eliz@gnu.org>
parents:
40785
diff
changeset
|
30 " by " |
c07c0f7a2c8e
(calc-record-compilation-date-macro): Return a
Eli Zaretskii <eliz@gnu.org>
parents:
40785
diff
changeset
|
31 (user-full-name)))) |
40785 | 32 |
33 | |
34 (defmacro calc-wrapper (&rest body) | |
35 (list 'calc-do (list 'function (append (list 'lambda ()) body))) | |
36 ) | |
37 | |
38 ;; We use "point" here to generate slightly smaller byte-code than "t". | |
39 (defmacro calc-slow-wrapper (&rest body) | |
40 (list 'calc-do (list 'function (append (list 'lambda ()) body)) (point)) | |
41 ) | |
42 | |
43 | |
44 (defmacro math-showing-full-precision (body) | |
45 (list 'let | |
46 '((calc-float-format calc-full-float-format)) | |
47 body) | |
48 ) | |
49 | |
50 | |
51 (defmacro math-with-extra-prec (delta &rest body) | |
52 (` (math-normalize | |
53 (let ((calc-internal-prec (+ calc-internal-prec (, delta)))) | |
54 (,@ body)))) | |
55 ) | |
56 | |
57 | |
58 ;;; Faster in-line version zerop, normalized values only. | |
59 (defmacro Math-zerop (a) ; [P N] | |
60 (` (if (consp (, a)) | |
61 (and (not (memq (car (, a)) '(bigpos bigneg))) | |
62 (if (eq (car (, a)) 'float) | |
63 (eq (nth 1 (, a)) 0) | |
64 (math-zerop (, a)))) | |
65 (eq (, a) 0))) | |
66 ) | |
67 | |
68 (defmacro Math-integer-negp (a) | |
69 (` (if (consp (, a)) | |
70 (eq (car (, a)) 'bigneg) | |
71 (< (, a) 0))) | |
72 ) | |
73 | |
74 (defmacro Math-integer-posp (a) | |
75 (` (if (consp (, a)) | |
76 (eq (car (, a)) 'bigpos) | |
77 (> (, a) 0))) | |
78 ) | |
79 | |
80 | |
81 (defmacro Math-negp (a) | |
82 (` (if (consp (, a)) | |
83 (or (eq (car (, a)) 'bigneg) | |
84 (and (not (eq (car (, a)) 'bigpos)) | |
85 (if (memq (car (, a)) '(frac float)) | |
86 (Math-integer-negp (nth 1 (, a))) | |
87 (math-negp (, a))))) | |
88 (< (, a) 0))) | |
89 ) | |
90 | |
91 | |
92 (defmacro Math-looks-negp (a) ; [P x] [Public] | |
93 (` (or (Math-negp (, a)) | |
94 (and (consp (, a)) (or (eq (car (, a)) 'neg) | |
95 (and (memq (car (, a)) '(* /)) | |
96 (or (math-looks-negp (nth 1 (, a))) | |
97 (math-looks-negp (nth 2 (, a))))))))) | |
98 ) | |
99 | |
100 | |
101 (defmacro Math-posp (a) | |
102 (` (if (consp (, a)) | |
103 (or (eq (car (, a)) 'bigpos) | |
104 (and (not (eq (car (, a)) 'bigneg)) | |
105 (if (memq (car (, a)) '(frac float)) | |
106 (Math-integer-posp (nth 1 (, a))) | |
107 (math-posp (, a))))) | |
108 (> (, a) 0))) | |
109 ) | |
110 | |
111 | |
112 (defmacro Math-integerp (a) | |
113 (` (or (not (consp (, a))) | |
114 (memq (car (, a)) '(bigpos bigneg)))) | |
115 ) | |
116 | |
117 | |
118 (defmacro Math-natnump (a) | |
119 (` (if (consp (, a)) | |
120 (eq (car (, a)) 'bigpos) | |
121 (>= (, a) 0))) | |
122 ) | |
123 | |
124 (defmacro Math-ratp (a) | |
125 (` (or (not (consp (, a))) | |
126 (memq (car (, a)) '(bigpos bigneg frac)))) | |
127 ) | |
128 | |
129 (defmacro Math-realp (a) | |
130 (` (or (not (consp (, a))) | |
131 (memq (car (, a)) '(bigpos bigneg frac float)))) | |
132 ) | |
133 | |
134 (defmacro Math-anglep (a) | |
135 (` (or (not (consp (, a))) | |
136 (memq (car (, a)) '(bigpos bigneg frac float hms)))) | |
137 ) | |
138 | |
139 (defmacro Math-numberp (a) | |
140 (` (or (not (consp (, a))) | |
141 (memq (car (, a)) '(bigpos bigneg frac float cplx polar)))) | |
142 ) | |
143 | |
144 (defmacro Math-scalarp (a) | |
145 (` (or (not (consp (, a))) | |
146 (memq (car (, a)) '(bigpos bigneg frac float cplx polar hms)))) | |
147 ) | |
148 | |
149 (defmacro Math-vectorp (a) | |
150 (` (and (consp (, a)) (eq (car (, a)) 'vec))) | |
151 ) | |
152 | |
153 (defmacro Math-messy-integerp (a) | |
154 (` (and (consp (, a)) | |
155 (eq (car (, a)) 'float) | |
156 (>= (nth 2 (, a)) 0))) | |
157 ) | |
158 | |
159 (defmacro Math-objectp (a) ; [Public] | |
160 (` (or (not (consp (, a))) | |
161 (memq (car (, a)) | |
162 '(bigpos bigneg frac float cplx polar hms date sdev intv mod)))) | |
163 ) | |
164 | |
165 (defmacro Math-objvecp (a) ; [Public] | |
166 (` (or (not (consp (, a))) | |
167 (memq (car (, a)) | |
168 '(bigpos bigneg frac float cplx polar hms date | |
169 sdev intv mod vec)))) | |
170 ) | |
171 | |
172 | |
173 ;;; Compute the negative of A. [O O; o o] [Public] | |
174 (defmacro Math-integer-neg (a) | |
175 (` (if (consp (, a)) | |
176 (if (eq (car (, a)) 'bigpos) | |
177 (cons 'bigneg (cdr (, a))) | |
178 (cons 'bigpos (cdr (, a)))) | |
179 (- (, a)))) | |
180 ) | |
181 | |
182 | |
183 (defmacro Math-equal (a b) | |
184 (` (= (math-compare (, a) (, b)) 0)) | |
185 ) | |
186 | |
187 (defmacro Math-lessp (a b) | |
188 (` (= (math-compare (, a) (, b)) -1)) | |
189 ) | |
190 | |
191 | |
192 (defmacro math-working (msg arg) ; [Public] | |
193 (` (if (eq calc-display-working-message 'lots) | |
194 (math-do-working (, msg) (, arg)))) | |
195 ) | |
196 | |
197 | |
198 (defmacro calc-with-default-simplification (body) | |
199 (list 'let | |
200 '((calc-simplify-mode (and (not (memq calc-simplify-mode '(none num))) | |
201 calc-simplify-mode))) | |
202 body) | |
203 ) | |
204 | |
205 | |
206 (defmacro Math-primp (a) | |
207 (` (or (not (consp (, a))) | |
208 (memq (car (, a)) '(bigpos bigneg frac float cplx polar | |
209 hms date mod var)))) | |
210 ) | |
211 | |
212 | |
213 (defmacro calc-with-trail-buffer (&rest body) | |
214 (` (let ((save-buf (current-buffer)) | |
215 (calc-command-flags nil)) | |
216 (unwind-protect | |
217 (, (append '(progn | |
218 (set-buffer (calc-trail-display t)) | |
219 (goto-char calc-trail-pointer)) | |
220 body)) | |
221 (set-buffer save-buf)))) | |
222 ) | |
223 | |
224 | |
225 (defmacro Math-num-integerp (a) | |
226 (` (or (not (consp (, a))) | |
227 (memq (car (, a)) '(bigpos bigneg)) | |
228 (and (eq (car (, a)) 'float) | |
229 (>= (nth 2 (, a)) 0)))) | |
230 ) | |
231 | |
232 | |
233 (defmacro Math-bignum-test (a) ; [B N; B s; b b] | |
234 (` (if (consp (, a)) | |
235 (, a) | |
236 (math-bignum (, a)))) | |
237 ) | |
238 | |
239 | |
240 (defmacro Math-equal-int (a b) | |
241 (` (or (eq (, a) (, b)) | |
242 (and (consp (, a)) | |
243 (eq (car (, a)) 'float) | |
244 (eq (nth 1 (, a)) (, b)) | |
245 (= (nth 2 (, a)) 0)))) | |
246 ) | |
247 | |
248 (defmacro Math-natnum-lessp (a b) | |
249 (` (if (consp (, a)) | |
250 (and (consp (, b)) | |
251 (= (math-compare-bignum (cdr (, a)) (cdr (, b))) -1)) | |
252 (or (consp (, b)) | |
253 (< (, a) (, b))))) | |
254 ) | |
255 | |
256 | |
257 (defmacro math-format-radix-digit (a) ; [X D] | |
258 (` (aref math-radix-digits (, a))) | |
259 ) | |
260 | |
261 |