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