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 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 2, 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