calc-keypd.el

Revision 4220, 21.0 kB (checked in by miyoshi, 9 months ago)
Sync up with Emacs22.2.

Line
1	;;; calc-keypd.el --- mouse-capable keypad input for Calc
2
3	;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004,
4	;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
5
6	;; Author: David Gillespie <daveg@synaptics.com>
7	;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
8
9	;; This file is part of GNU Emacs.
10
11	;; GNU Emacs is free software; you can redistribute it and/or modify
12	;; it under the terms of the GNU General Public License as published by
13	;; the Free Software Foundation; either version 3, or (at your option)
14	;; any later version.
15
16	;; GNU Emacs is distributed in the hope that it will be useful,
17	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19	;; GNU General Public License for more details.
20
21	;; You should have received a copy of the GNU General Public License
22	;; along with GNU Emacs; see the file COPYING. If not, write to the
23	;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24	;; Boston, MA 02110-1301, USA.
25
26	;;; Commentary:
27
28	;;; Code:
29
30	;; This file is autoloaded from calc-ext.el.
31
32	(require 'calc-ext)
33	(require 'calc-macs)
34
35	(defvar calc-keypad-buffer nil)
36	(defvar calc-keypad-menu 0)
37	(defvar calc-keypad-full-layout nil)
38	(defvar calc-keypad-input nil)
39	(defvar calc-keypad-prev-input nil)
40	(defvar calc-keypad-said-hello nil)
41
42	;;; \|----+----+----+----+----+----\|
43	;;; \| ENTER \|+/- \|EEX \|UNDO\| <- \|
44	;;; \|-----+---+-+--+--+-+---++----\|
45	;;; \| INV \| 7 \| 8 \| 9 \| / \|
46	;;; \|-----+-----+-----+-----+-----\|
47	;;; \| HYP \| 4 \| 5 \| 6 \| \|*
48	;;; \|-----+-----+-----+-----+-----\|
49	;;; \|EXEC \| 1 \| 2 \| 3 \| - \|
50	;;; \|-----+-----+-----+-----+-----\|
51	;;; \| OFF \| 0 \| . \| PI \| + \|
52	;;; \|-----+-----+-----+-----+-----\|
53	(defvar calc-keypad-layout
54	'( ( ( "ENTER" calc-enter calc-roll-down calc-roll-up calc-over )
55	( "ENTER" calc-enter calc-roll-down calc-roll-up calc-over )
56	( "+/-" calc-change-sign calc-inv (progn -4 calc-pack) )
57	( "EEX" ("e") (progn calc-num-prefix calc-pack-interval)
58	(progn -5 calc-pack) )
59	( "UNDO" calc-undo calc-redo calc-last-args )
60	( "<-" calc-pop (progn 0 calc-pop)
61	(progn calc-num-prefix calc-pop) ) )
62	( ( "INV" calc-inverse )
63	( "7" ("7") calc-round )
64	( "8" ("8") (progn 2 calc-clean-num) )
65	( "9" ("9") calc-float )
66	( "/" calc-divide (progn calc-inverse calc-power) ) )
67	( ( "HYP" calc-hyperbolic )
68	( "4" ("4") calc-ln calc-log10 )
69	( "5" ("5") calc-exp calc-exp10 )
70	( "6" ("6") calc-abs )
71	( *""** calc-times calc-power ) )
72	( ( "EXEC" calc-keypad-execute )
73	( "1" ("1") calc-arcsin calc-sin )
74	( "2" ("2") calc-arccos calc-cos )
75	( "3" ("3") calc-arctan calc-tan )
76	( "-" calc-minus calc-conj ) )
77	( ( "OFF" calc-keypad-off )
78	( "0" ("0") calc-imaginary )
79	( "." (".") calc-precision )
80	( "PI" calc-pi )
81	( "+" calc-plus calc-sqrt ) ) ))
82
83	(defvar calc-keypad-menus '( calc-keypad-math-menu
84	calc-keypad-funcs-menu
85	calc-keypad-binary-menu
86	calc-keypad-vector-menu
87	calc-keypad-modes-menu
88	calc-keypad-user-menu ) )
89
90	;;; \|----+----+----+----+----+----\|
91	;;; \|FLR \|CEIL\|RND \|TRNC\|CLN2\|FLT \|
92	;;; \|----+----+----+----+----+----\|
93	;;; \| LN \|EXP \| \|ABS \|IDIV\|MOD \|
94	;;; \|----+----+----+----+----+----\|
95	;;; \|SIN \|COS \|TAN \|SQRT\|y^x \|1/x \|
96
97	(defvar calc-keypad-math-menu
98	'( ( ( "FLR" calc-floor )
99	( "CEIL" calc-ceiling )
100	( "RND" calc-round )
101	( "TRNC" calc-trunc )
102	( "CLN2" (progn 2 calc-clean-num) )
103	( "FLT" calc-float ) )
104	( ( "LN" calc-ln )
105	( "EXP" calc-exp )
106	( "" nil )
107	( "ABS" calc-abs )
108	( "IDIV" calc-idiv )
109	( "MOD" calc-mod ) )
110	( ( "SIN" calc-sin )
111	( "COS" calc-cos )
112	( "TAN" calc-tan )
113	( "SQRT" calc-sqrt )
114	( "y^x" calc-power )
115	( "1/x" calc-inv ) ) ))
116
117	;;; \|----+----+----+----+----+----\|
118	;;; \|IGAM\|BETA\|IBET\|ERF \|BESJ\|BESY\|
119	;;; \|----+----+----+----+----+----\|
120	;;; \|IMAG\|CONJ\| RE \|ATN2\|RAND\|RAGN\|
121	;;; \|----+----+----+----+----+----\|
122	;;; \|GCD \|FACT\|DFCT\|BNOM\|PERM\|NXTP\|
123
124	(defvar calc-keypad-funcs-menu
125	'( ( ( "IGAM" calc-inc-gamma )
126	( "BETA" calc-beta )
127	( "IBET" calc-inc-beta )
128	( "ERF" calc-erf )
129	( "BESJ" calc-bessel-J )
130	( "BESY" calc-bessel-Y ) )
131	( ( "IMAG" calc-imaginary )
132	( "CONJ" calc-conj )
133	( "RE" calc-re calc-im )
134	( "ATN2" calc-arctan2 )
135	( "RAND" calc-random )
136	( "RAGN" calc-random-again ) )
137	( ( "GCD" calc-gcd calc-lcm )
138	( "FACT" calc-factorial calc-gamma )
139	( "DFCT" calc-double-factorial )
140	( "BNOM" calc-choose )
141	( "PERM" calc-perm )
142	( "NXTP" calc-next-prime calc-prev-prime ) ) ))
143
144	;;; \|----+----+----+----+----+----\|
145	;;; \|AND \| OR \|XOR \|NOT \|LSH \|RSH \|
146	;;; \|----+----+----+----+----+----\|
147	;;; \|DEC \|HEX \|OCT \|BIN \|WSIZ\|ARSH\|
148	;;; \|----+----+----+----+----+----\|
149	;;; \| A \| B \| C \| D \| E \| F \|
150
151	(defvar calc-keypad-binary-menu
152	'( ( ( "AND" calc-and calc-diff )
153	( "OR" calc-or )
154	( "XOR" calc-xor )
155	( "NOT" calc-not calc-clip )
156	( "LSH" calc-lshift-binary calc-rotate-binary )
157	( "RSH" calc-rshift-binary ) )
158	( ( "DEC" calc-decimal-radix )
159	( "HEX" calc-hex-radix )
160	( "OCT" calc-octal-radix )
161	( "BIN" calc-binary-radix )
162	( "WSIZ" calc-word-size )
163	( "ARSH" calc-rshift-arith ) )
164	( ( "A" ("A") )
165	( "B" ("B") )
166	( "C" ("C") )
167	( "D" ("D") )
168	( "E" ("E") )
169	( "F" ("F") ) ) ))
170
171	;;; \|----+----+----+----+----+----\|
172	;;; \|SUM \|PROD\|MAX \|MAP\|MAP^\|MAP$\|*
173	;;; \|----+----+----+----+----+----\|
174	;;; \|INV \|DET \|TRN \|IDNT\|CRSS\|"x" \|
175	;;; \|----+----+----+----+----+----\|
176	;;; \|PACK\|UNPK\|INDX\|BLD \|LEN \|... \|
177
178	(defvar calc-keypad-vector-menu
179	'( ( ( "SUM" calc-vector-sum calc-vector-alt-sum calc-vector-mean )
180	( "PROD" calc-vector-product nil calc-vector-sdev )
181	( "MAX" calc-vector-max calc-vector-min calc-vector-median )
182	( *"MAP" (lambda** () (interactive)
183	(calc-map '(2 calcFunc-mul *""**))) )
184	( "MAP^" (lambda () (interactive)
185	(calc-map '(2 calcFunc-pow "^"))) )
186	( "MAP$" calc-map-stack ) )
187	( ( "MINV" calc-inv )
188	( "MDET" calc-mdet )
189	( "MTRN" calc-transpose calc-conj-transpose )
190	( "IDNT" (progn calc-num-prefix calc-ident) )
191	( "CRSS" calc-cross )
192	( "\"x\"" "\excalc-algebraic-entry\rx\r"
193	"\excalc-algebraic-entry\ry\r"
194	"\excalc-algebraic-entry\rz\r"
195	"\excalc-algebraic-entry\rt\r") )
196	( ( "PACK" calc-pack )
197	( "UNPK" calc-unpack )
198	( "INDX" (progn calc-num-prefix calc-index) "\C-u\excalc-index\r" )
199	( "BLD" (progn calc-num-prefix calc-build-vector) )
200	( "LEN" calc-vlength )
201	( "..." calc-full-vectors ) ) ))
202
203	;;; \|----+----+----+----+----+----\|
204	;;; \|FLT \|FIX \|SCI \|ENG \|GRP \| \|
205	;;; \|----+----+----+----+----+----\|
206	;;; \|RAD \|DEG \|FRAC\|POLR\|SYMB\|PREC\|
207	;;; \|----+----+----+----+----+----\|
208	;;; \|SWAP\|RLL3\|RLL4\|OVER\|STO \|RCL \|
209
210	(defvar calc-keypad-modes-menu
211	'( ( ( "FLT" calc-normal-notation
212	(progn calc-num-prefix calc-normal-notation) )
213	( "FIX" (progn 2 calc-fix-notation)
214	(progn calc-num-prefix calc-fix-notation) )
215	( "SCI" calc-sci-notation
216	(progn calc-num-prefix calc-sci-notation) )
217	( "ENG" calc-eng-notation
218	(progn calc-num-prefix calc-eng-notation) )
219	( "GRP" calc-group-digits "\C-u-3\excalc-group-digits\r" )
220	( "" nil ) )
221	( ( "RAD" calc-radians-mode )
222	( "DEG" calc-degrees-mode )
223	( "FRAC" calc-frac-mode )
224	( "POLR" calc-polar-mode )
225	( "SYMB" calc-symbolic-mode )
226	( "PREC" calc-precision ) )
227	( ( "SWAP" calc-roll-down )
228	( "RLL3" (progn 3 calc-roll-up) (progn 3 calc-roll-down) )
229	( "RLL4" (progn 4 calc-roll-up) (progn 4 calc-roll-down) )
230	( "OVER" calc-over )
231	( "STO" calc-keypad-store )
232	( "RCL" calc-keypad-recall ) ) ))
233
234	(define-derived-mode calc-keypad-mode fundamental-mode "Calculator"
235	"Major mode for Calc keypad input."
236	(define-key calc-keypad-mode-map " " 'calc-keypad-press)
237	(define-key calc-keypad-mode-map (kbd "RET") 'calc-keypad-press)
238	(define-key calc-keypad-mode-map (kbd "TAB") 'calc-keypad-menu)
239	(define-key calc-keypad-mode-map "q" 'calc-keypad-off)
240	(define-key calc-keypad-mode-map [down-mouse-1] 'ignore)
241	(define-key calc-keypad-mode-map [drag-mouse-1] 'ignore)
242	(define-key calc-keypad-mode-map [double-mouse-1] 'ignore)
243	(define-key calc-keypad-mode-map [triple-mouse-1] 'ignore)
244	(define-key calc-keypad-mode-map [down-mouse-2] 'ignore)
245	(define-key calc-keypad-mode-map [drag-mouse-2] 'ignore)
246	(define-key calc-keypad-mode-map [double-mouse-2] 'ignore)
247	(define-key calc-keypad-mode-map [triple-mouse-2] 'ignore)
248	(define-key calc-keypad-mode-map [down-mouse-3] 'ignore)
249	(define-key calc-keypad-mode-map [drag-mouse-3] 'ignore)
250	(define-key calc-keypad-mode-map [double-mouse-3] 'ignore)
251	(define-key calc-keypad-mode-map [triple-mouse-3] 'ignore)
252	(define-key calc-keypad-mode-map [mouse-3] 'calc-keypad-right-click)
253	(define-key calc-keypad-mode-map [mouse-2] 'calc-keypad-middle-click)
254	(define-key calc-keypad-mode-map [mouse-1] 'calc-keypad-left-click)
255	(put 'calc-keypad-mode 'mode-class 'special)
256	(make-local-variable 'calc-main-buffer))
257
258	(defun calc-do-keypad (&optional full-display interactive)
259	(calc-create-buffer)
260	(let ((calcbuf (current-buffer)))
261	(unless (bufferp calc-keypad-buffer)
262	(set-buffer (setq calc-keypad-buffer (get-buffer-create *"Calc Keypad"*)))
263	(calc-keypad-mode)
264	(setq calc-main-buffer calcbuf)
265	(calc-keypad-redraw)
266	(calc-trail-buffer))
267	(let ((width 29)
268	(height 17)
269	win old-win)
270	(if (setq win (get-buffer-window *"Calculator"*))
271	(delete-window win))
272	(if (setq win (get-buffer-window *"Calc Trail"*))
273	(if (one-window-p)
274	(switch-to-buffer (other-buffer))
275	(delete-window win)))
276	(if (setq win (get-buffer-window calc-keypad-buffer))
277	(progn
278	(bury-buffer *"Calculator"*)
279	(bury-buffer *"Calc Trail"*)
280	(bury-buffer calc-keypad-buffer)
281	(if (one-window-p)
282	(switch-to-buffer (other-buffer))
283	(delete-window win)))
284	(setq calc-was-keypad-mode t
285	old-win (get-largest-window))
286	(if (or (< (window-height old-win) (+ height 6))
287	(< (window-width old-win) (+ width 15))
288	full-display)
289	(delete-other-windows old-win))
290	(if (< (window-height old-win) (+ height 4))
291	(error "Screen is not tall enough for this mode"))
292	(if full-display
293	(progn
294	(setq win (split-window old-win (- (window-height old-win)
295	height 1)))
296	(set-window-buffer old-win (calc-trail-buffer))
297	(set-window-buffer win calc-keypad-buffer)
298	(set-window-start win 1)
299	(setq win (split-window win (+ width 7) t))
300	(set-window-buffer win calcbuf))
301	(if (or t ; left-side keypad not yet fully implemented
302	(< (save-excursion
303	(set-buffer (window-buffer old-win))
304	(current-column))
305	(/ (window-width) 2)))
306	(setq win (split-window old-win (- (window-width old-win)
307	width 2)
308	t))
309	(setq old-win (split-window old-win (+ width 2) t)))
310	(set-window-buffer win calc-keypad-buffer)
311	(set-window-start win 1)
312	(split-window win (- (window-height win) height 1))
313	(set-window-buffer win calcbuf))
314	(select-window old-win)
315	(message "Welcome to GNU Emacs Calc! Use the left and right mouse buttons")
316	(run-hooks 'calc-keypad-start-hook)
317	(and calc-keypad-said-hello interactive
318	(progn
319	(sit-for 2)
320	(message "")))
321	(setq calc-keypad-said-hello t)))
322	(setq calc-keypad-input nil)))
323
324	(defun calc-keypad-off ()
325	(interactive)
326	(if calc-standalone-flag
327	(save-buffers-kill-emacs nil)
328	(calc-keypad)))
329
330	(defun calc-keypad-redraw ()
331	(set-buffer calc-keypad-buffer)
332	(setq buffer-read-only t)
333	(setq calc-keypad-full-layout (append (symbol-value (nth calc-keypad-menu
334	calc-keypad-menus))
335	calc-keypad-layout))
336	(let ((buffer-read-only nil)
337	(row calc-keypad-full-layout)
338	(y 0))
339	(erase-buffer)
340	(insert "\n")
341	(while row
342	(let ((col (car row)))
343	(while col
344	(let* ((key (car col))
345	(cwid (if (>= y 4)
346	5
347	(if (and (= y 3) (eq col (car row)))
348	(progn (setq col (cdr col)) 9)
349	4)))
350	(name (if (and calc-standalone-flag
351	(eq (nth 1 key) 'calc-keypad-off))
352	"EXIT"
353	(if (> (length (car key)) cwid)
354	(substring (car key) 0 cwid)
355	(car key))))
356	(wid (length name))
357	(pad (- cwid (/ wid 2))))
358	(insert (make-string (/ (- cwid wid) 2) 32)
359	name
360	(make-string (/ (- cwid wid -1) 2) 32)
361	(if (equal name "MENU")
362	(int-to-string (1+ calc-keypad-menu))
363	"\|")))
364	(or (setq col (cdr col))
365	(insert "\n")))
366	(insert (if (>= y 4)
367	"-----+-----+-----+-----+-----"
368	(if (= y 3)
369	"-----+---+-+--+--+-+---++----"
370	"----+----+----+----+----+----"))
371	(if (= y 7) "+\n" "\|\n"))
372	(setq y (1+ y)
373	row (cdr row)))))
374	(setq calc-keypad-prev-input t)
375	(calc-keypad-show-input)
376	(goto-char (point-min)))
377
378	(defun calc-keypad-show-input ()
379	(or (equal calc-keypad-input calc-keypad-prev-input)
380	(let ((buffer-read-only nil))
381	(save-excursion
382	(goto-char (point-min))
383	(forward-line 1)
384	(delete-region (point-min) (point))
385	(if calc-keypad-input
386	(insert "Calc: " calc-keypad-input "\n")
387	(insert "----+-----Calc " calc-version " -----+----"
388	(int-to-string (1+ calc-keypad-menu))
389	"\n")))))
390	(setq calc-keypad-prev-input calc-keypad-input))
391
392	(defun calc-keypad-press ()
393	(interactive)
394	(unless (eq major-mode 'calc-keypad-mode)
395	(error *"Must be in Calc Keypad* buffer for this command"**))
396	(let* ((row (save-excursion
397	(beginning-of-line)
398	(count-lines (point-min) (point))))
399	(y (/ row 2))
400	(x (/ (current-column) (if (>= y 4) 6 5)))
401	radix frac inv
402	(hyp (with-current-buffer calc-main-buffer
403	(setq radix calc-number-radix
404	frac calc-prefer-frac
405	inv calc-inverse-flag)
406	calc-hyperbolic-flag))
407	(invhyp t)
408	(menu (symbol-value (nth calc-keypad-menu calc-keypad-menus)))
409	(input calc-keypad-input)
410	(iexpon (and input
411	(or (string-match *"\\[0-9]+\\.\\^"** input)
412	(and (<= radix 14) (string-match "e" input)))
413	(match-end 0)))
414	(key (nth x (nth y calc-keypad-full-layout)))
415	(cmd (or (nth (if inv (if hyp 4 2) (if hyp 3 99)) key)
416	(setq invhyp nil)
417	(nth 1 key)))
418	(isstring (and (consp cmd) (stringp (car cmd))))
419	(calc-is-keypad-press t))
420	(if invhyp (calc-wrapper)) ; clear Inv and Hyp flags
421	(unwind-protect
422	(cond ((or (null cmd)
423	(= (% row 2) 0))
424	(beep))
425	((and (> (minibuffer-depth) 0))
426	(cond (isstring
427	(push (aref (car cmd) 0) unread-command-events))
428	((eq cmd 'calc-pop)
429	(push ?\177 unread-command-events))
430	((eq cmd 'calc-enter)
431	(push 13 unread-command-events))
432	((eq cmd 'calc-undo)
433	(push 7 unread-command-events))
434	(t
435	(beep))))
436	((and input (string-match "STO\\\|RCL" input))
437	(cond ((and isstring (string-match "[0-9]" (car cmd)))
438	(setq calc-keypad-input nil)
439	(let ((var (intern (concat "var-q" (car cmd)))))
440	(cond ((equal input "STO+") (calc-store-plus var))
441	((equal input "STO-") (calc-store-minus var))
442	((equal input *"STO"**) (calc-store-times var))
443	((equal input "STO/") (calc-store-div var))
444	((equal input "STO^") (calc-store-power var))
445	((equal input "STOn") (calc-store-neg 1 var))
446	((equal input "STO&") (calc-store-inv 1 var))
447	((equal input "STO") (calc-store-into var))
448	(t (calc-recall var)))))
449	((memq cmd '(calc-pop calc-undo))
450	(setq calc-keypad-input nil))
451	((and (equal input "STO")
452	(setq frac (assq cmd '( ( calc-plus . "+" )
453	( calc-minus . "-" )
454	( calc-times . *""** )
455	( calc-divide . "/" )
456	( calc-power . "^")
457	( calc-change-sign . "n")
458	( calc-inv . "&") ))))
459	(setq calc-keypad-input (concat input (cdr frac))))
460	(t
461	(beep))))
462	(isstring
463	(setq cmd (car cmd))
464	(if (or (and (equal cmd ".")
465	input
466	(string-match "[.:e^]" input))
467	(and (equal cmd "e")
468	input
469	(or (and (<= radix 14) (string-match "e" input))
470	(string-match "\\^\\\|[-.:]\\'" input)))
471	(and (not (equal cmd "."))
472	(let ((case-fold-search nil))
473	(string-match cmd "0123456789ABCDEF"
474	(if (string-match
475	"[e^]" (or input ""))
476	10 radix)))))
477	(beep)
478	(setq calc-keypad-input (concat
479	(and (/= radix 10)
480	(or (not input)
481	(equal input "-"))
482	(format "%d#" radix))
483	(and (or (not input)
484	(equal input "-"))
485	(or (and (equal cmd "e") "1")
486	(and (equal cmd ".")
487	(if frac "1" "0"))))
488	input
489	(if (and (equal cmd ".") frac)
490	":"
491	(if (and (equal cmd "e")
492	(or (not input)
493	(string-match
494	"#" input))
495	(> radix 14))
496	(format *"%d.^"** radix)
497	cmd))))))
498	((and (eq cmd 'calc-change-sign)
499	input)
500	(let* ((epos (or iexpon 0))
501	(suffix (substring input epos)))
502	(setq calc-keypad-input (concat
503	(substring input 0 epos)
504	(if (string-match "\\`-" suffix)
505	(substring suffix 1)
506	(concat "-" suffix))))))
507	((and (eq cmd 'calc-pop)
508	input)
509	(if (equal input "")
510	(beep)
511	(setq calc-keypad-input (substring input 0
512	(or (string-match
513	*"\\[0-9]+\\.\\^\\'"**
514	input)
515	-1)))))
516	((and (eq cmd 'calc-undo)
517	input)
518	(setq calc-keypad-input nil))
519	(t
520	(if input
521	(let ((val (math-read-number input)))
522	(setq calc-keypad-input nil)
523	(if val
524	(calc-wrapper
525	(calc-push-list (list (calc-record
526	(calc-normalize val)))))
527	(or (equal input "")
528	(beep))
529	(setq cmd nil))
530	(if (eq cmd 'calc-enter) (setq cmd nil))))
531	(setq prefix-arg current-prefix-arg)
532	(if cmd
533	(if (and (consp cmd) (eq (car cmd) 'progn))
534	(while (setq cmd (cdr cmd))
535	(if (integerp (car cmd))
536	(setq prefix-arg (car cmd))
537	(command-execute (car cmd))))
538	(command-execute cmd)))))
539	(set-buffer calc-keypad-buffer)
540	(calc-keypad-show-input))))
541
542	(defun calc-keypad-left-click (event)
543	"Handle a left-button mouse click in Calc Keypad window."
544	(interactive "e")
545	(with-current-buffer calc-keypad-buffer
546	(goto-char (posn-point (event-start event)))
547	(calc-keypad-press)))
548
549	(defun calc-keypad-right-click (event)
550	"Handle a right-button mouse click in Calc Keypad window."
551	(interactive "e")
552	(save-excursion
553	(set-buffer calc-keypad-buffer)
554	(calc-keypad-menu)))
555
556	(defun calc-keypad-middle-click (event)
557	"Handle a middle-button mouse click in Calc Keypad window."
558	(interactive "e")
559	(with-current-buffer calc-keypad-buffer
560	(calc-keypad-menu-back)))
561
562	(defun calc-keypad-menu ()
563	(interactive)
564	(unless (eq major-mode 'calc-keypad-mode)
565	(error *"Must be in Calc Keypad* buffer for this command"**))
566	(while (progn (setq calc-keypad-menu (% (1+ calc-keypad-menu)
567	(length calc-keypad-menus)))
568	(not (symbol-value (nth calc-keypad-menu calc-keypad-menus)))))
569	(calc-keypad-redraw))
570
571	(defun calc-keypad-menu-back ()
572	(interactive)
573	(or (eq major-mode 'calc-keypad-mode)
574	(error *"Must be in Calc Keypad* buffer for this command"**))
575	(while (progn (setq calc-keypad-menu (% (1- (+ calc-keypad-menu
576	(length calc-keypad-menus)))
577	(length calc-keypad-menus)))
578	(not (symbol-value (nth calc-keypad-menu calc-keypad-menus)))))
579	(calc-keypad-redraw))
580
581	(defun calc-keypad-store ()
582	(interactive)
583	(setq calc-keypad-input "STO"))
584
585	(defun calc-keypad-recall ()
586	(interactive)
587	(setq calc-keypad-input "RCL"))
588
589	(defun calc-pack-interval (mode)
590	(interactive "p")
591	(if (or (< mode 0) (> mode 3))
592	(error "Open/close code should be in the range from 0 to 3"))
593	(calc-pack (- -6 mode)))
594
595	(defun calc-keypad-execute ()
596	(interactive)
597	(let* ((prompt "Calc keystrokes: ")
598	(flush 'x-flush-mouse-queue)
599	(prefix nil)
600	keys cmd)
601	(save-excursion
602	(calc-select-buffer)
603	(while (progn
604	(setq keys (read-key-sequence prompt))
605	(setq cmd (key-binding keys))
606	(if (or (memq cmd '(calc-inverse
607	calc-hyperbolic
608	universal-argument
609	digit-argument
610	negative-argument))
611	(and prefix (string-match "\\`\e?[-0-9]\\'" keys)))
612	(progn
613	(setq last-command-char (aref keys (1- (length keys))))
614	(command-execute cmd)
615	(setq flush 'not-any-more
616	prefix t
617	prompt (concat prompt (key-description keys) " ")))
618	(eq cmd flush))))) ; skip mouse-up event
619	(message "")
620	(if (commandp cmd)
621	(command-execute cmd)
622	(error "Not a Calc command: %s" (key-description keys)))))
623
624	(provide 'calc-keypd)
625
626	;;; arch-tag: 4ba0d360-2bb6-40b8-adfa-eb373765b3f9
627	;;; calc-keypd.el ends here
628

Note: See TracBrowser for help on using the browser.

root/trunk/lisp/calc/calc-keypd.el

Download in other formats: