view lisp/calc/calc-keypd.el @ 59384:a1edc5959dcf

* macfns.c: Include sys/param.h. [TARGET_API_MAC_CARBON] (mac_nav_event_callback): New declaration and function. [TARGET_API_MAC_CARBON] (Fx_file_dialog): Use MAXPATHLEN for size of filename string. Set event callback function when creating dialog boxes. Add code conversions for filenames. Don't dispose apple event descriptor record if failed to create it. * macterm.c: Include sys/param.h. [USE_CARBON_EVENTS] (mac_handle_window_event): Add handler for kEventWindowUpdate. (install_window_handler) [USE_CARBON_EVENTS]: Register it. (do_ae_open_documents) [TARGET_API_MAC_CARBON]: Get FSRef instead of FSSpec from apple event descriptor record. (do_ae_open_documents) [TARGET_API_MAC_CARBON]: Use MAXPATHLEN for size of filename string. [TARGET_API_MAC_CARBON] (mac_do_receive_drag): Likewise. [TARGET_API_MAC_CARBON] (mac_do_receive_drag): Return error when a file dialog is in action. [TARGET_API_MAC_CARBON] (mac_do_track_drag): Likewise. Reject only when there are no filename items. Set background color before (un)highlighting the window below the dragged items. (XTread_socket) [!USE_CARBON_EVENTS]: Don't call do_window_update.

;;; calc-keypd.el --- mouse-capable keypad input for Calc

;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.

;; Author: David Gillespie <[e-mail]>
;; Maintainer: Jay Belanger <[e-mail]>

;; This file is part of GNU Emacs.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY.  No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing.  Refer to the GNU Emacs General Public
;; License for full details.

;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License.   A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities.  It should be in a
;; file named COPYING.  Among other things, the copyright notice
;; and this notice must be preserved on all copies.

;;; Commentary:

;;; Code:

;; This file is autoloaded from calc-ext.el.

(require 'calc-ext)
(require 'calc-macs)

(defvar calc-keypad-buffer nil)
(defvar calc-keypad-menu 0)
(defvar calc-keypad-full-layout nil)
(defvar calc-keypad-input nil)
(defvar calc-keypad-prev-input nil)
(defvar calc-keypad-said-hello nil)

;;; |----+----+----+----+----+----|
;;; |  ENTER  |+/- |EEX |UNDO| <- |
;;; |-----+---+-+--+--+-+---++----|
;;; | INV |  7  |  8  |  9  |  /  |
;;; |-----+-----+-----+-----+-----|
;;; | HYP |  4  |  5  |  6  |  *  |
;;; |-----+-----+-----+-----+-----|
;;; |EXEC |  1  |  2  |  3  |  -  |
;;; |-----+-----+-----+-----+-----|
;;; | OFF |  0  |  .  | PI  |  +  |
;;; |-----+-----+-----+-----+-----|
(defvar calc-keypad-layout
  '( ( ( "ENTER" calc-enter calc-roll-down calc-roll-up calc-over )
       ( "ENTER" calc-enter calc-roll-down calc-roll-up calc-over )
       ( "+/-"	 calc-change-sign calc-inv (progn -4 calc-pack) )
       ( "EEX"	 ("e") (progn calc-num-prefix calc-pack-interval)
                 (progn -5 calc-pack)  )
       ( "UNDO"	 calc-undo calc-redo calc-last-args )
       ( "<-"	 calc-pop (progn 0 calc-pop)
	         (progn calc-num-prefix calc-pop) ) )
     ( ( "INV"   calc-inverse )
       ( "7"	 ("7") calc-round )
       ( "8"	 ("8") (progn 2 calc-clean-num) )
       ( "9"	 ("9") calc-float )
       ( "/"	 calc-divide (progn calc-inverse calc-power) ) )
     ( ( "HYP"   calc-hyperbolic )
       ( "4"	 ("4") calc-ln calc-log10 )
       ( "5"	 ("5") calc-exp calc-exp10 )
       ( "6"	 ("6") calc-abs )
       ( "*"	 calc-times calc-power ) )
     ( ( "EXEC"	 calc-keypad-execute )
       ( "1"	 ("1") calc-arcsin calc-sin )
       ( "2"	 ("2") calc-arccos calc-cos )
       ( "3"	 ("3") calc-arctan calc-tan )
       ( "-"	 calc-minus calc-conj ) )
     ( ( "OFF"   calc-keypad-off )
       ( "0"	 ("0") calc-imaginary )
       ( "."	 (".") calc-precision )
       ( "PI"	 calc-pi )
       ( "+"	 calc-plus calc-sqrt ) ) ))

(defvar calc-keypad-menus '( calc-keypad-math-menu
			     calc-keypad-funcs-menu
			     calc-keypad-binary-menu
			     calc-keypad-vector-menu
			     calc-keypad-modes-menu
			     calc-keypad-user-menu ) )

;;; |----+----+----+----+----+----|
;;; |FLR |CEIL|RND |TRNC|CLN2|FLT |
;;; |----+----+----+----+----+----|
;;; | LN |EXP |    |ABS |IDIV|MOD |
;;; |----+----+----+----+----+----|
;;; |SIN |COS |TAN |SQRT|y^x |1/x |

(defvar calc-keypad-math-menu
  '( ( ( "FLR"   calc-floor )
       ( "CEIL"  calc-ceiling )
       ( "RND"   calc-round )
       ( "TRNC"  calc-trunc )
       ( "CLN2"  (progn 2 calc-clean-num) )
       ( "FLT"   calc-float ) )
     ( ( "LN"    calc-ln )
       ( "EXP"   calc-exp )
       ( ""	 nil )
       ( "ABS"   calc-abs )
       ( "IDIV"  calc-idiv )
       ( "MOD"   calc-mod ) )
     ( ( "SIN"   calc-sin )
       ( "COS"   calc-cos )
       ( "TAN"   calc-tan )
       ( "SQRT"  calc-sqrt )
       ( "y^x"   calc-power )
       ( "1/x"   calc-inv ) ) ))

;;; |----+----+----+----+----+----|
;;; |IGAM|BETA|IBET|ERF |BESJ|BESY|
;;; |----+----+----+----+----+----|
;;; |IMAG|CONJ| RE |ATN2|RAND|RAGN|
;;; |----+----+----+----+----+----|
;;; |GCD |FACT|DFCT|BNOM|PERM|NXTP|

(defvar calc-keypad-funcs-menu
  '( ( ( "IGAM"  calc-inc-gamma )
       ( "BETA"  calc-beta )
       ( "IBET"  calc-inc-beta )
       ( "ERF"   calc-erf )
       ( "BESJ"  calc-bessel-J )
       ( "BESY"  calc-bessel-Y ) )
     ( ( "IMAG"  calc-imaginary )
       ( "CONJ"  calc-conj )
       ( "RE"	 calc-re calc-im )
       ( "ATN2"  calc-arctan2 )
       ( "RAND"  calc-random )
       ( "RAGN"  calc-random-again ) )
     ( ( "GCD"   calc-gcd calc-lcm )
       ( "FACT"  calc-factorial calc-gamma )
       ( "DFCT"  calc-double-factorial )
       ( "BNOM"  calc-choose )
       ( "PERM"  calc-perm )
       ( "NXTP"	 calc-next-prime calc-prev-prime ) ) ))

;;; |----+----+----+----+----+----|
;;; |AND | OR |XOR |NOT |LSH |RSH |
;;; |----+----+----+----+----+----|
;;; |DEC |HEX |OCT |BIN |WSIZ|ARSH|
;;; |----+----+----+----+----+----|
;;; | A  | B  | C  | D  | E  | F  |

(defvar calc-keypad-binary-menu
  '( ( ( "AND"   calc-and calc-diff )
       ( "OR"    calc-or )
       ( "XOR"   calc-xor )
       ( "NOT"   calc-not calc-clip )
       ( "LSH"   calc-lshift-binary calc-rotate-binary )
       ( "RSH"   calc-rshift-binary ) )
     ( ( "DEC"   calc-decimal-radix )
       ( "HEX"   calc-hex-radix )
       ( "OCT"   calc-octal-radix )
       ( "BIN"   calc-binary-radix )
       ( "WSIZ"  calc-word-size )
       ( "ARSH"  calc-rshift-arith ) )
     ( ( "A"     ("A") )
       ( "B"     ("B") )
       ( "C"     ("C") )
       ( "D"     ("D") )
       ( "E"     ("E") )
       ( "F"     ("F") ) ) ))

;;; |----+----+----+----+----+----|
;;; |SUM |PROD|MAX |MAP*|MAP^|MAP$|
;;; |----+----+----+----+----+----|
;;; |INV |DET |TRN |IDNT|CRSS|"x" |
;;; |----+----+----+----+----+----|
;;; |PACK|UNPK|INDX|BLD |LEN |... |

(defvar calc-keypad-vector-menu
  '( ( ( "SUM"   calc-vector-sum calc-vector-alt-sum calc-vector-mean )
       ( "PROD"  calc-vector-product nil calc-vector-sdev )
       ( "MAX"   calc-vector-max calc-vector-min calc-vector-median )
       ( "MAP*"  (lambda () (interactive)
		   (calc-map '(2 calcFunc-mul "*"))) )
       ( "MAP^"  (lambda () (interactive)
		   (calc-map '(2 calcFunc-pow "^"))) )
       ( "MAP$"  calc-map-stack ) )
     ( ( "MINV"  calc-inv )
       ( "MDET"  calc-mdet )
       ( "MTRN"  calc-transpose calc-conj-transpose )
       ( "IDNT"  (progn calc-num-prefix calc-ident) )
       ( "CRSS"  calc-cross )
       ( "\"x\"" "\excalc-algebraic-entry\rx\r"
	         "\excalc-algebraic-entry\ry\r"
		 "\excalc-algebraic-entry\rz\r"
		 "\excalc-algebraic-entry\rt\r") )
     ( ( "PACK"  calc-pack )
       ( "UNPK"  calc-unpack )
       ( "INDX"  (progn calc-num-prefix calc-index) "\C-u\excalc-index\r" )
       ( "BLD"   (progn calc-num-prefix calc-build-vector) )
       ( "LEN"   calc-vlength )
       ( "..."   calc-full-vectors ) ) ))

;;; |----+----+----+----+----+----|
;;; |FLT |FIX |SCI |ENG |GRP |    |
;;; |----+----+----+----+----+----|
;;; |RAD |DEG |FRAC|POLR|SYMB|PREC|
;;; |----+----+----+----+----+----|
;;; |SWAP|RLL3|RLL4|OVER|STO |RCL |

(defvar calc-keypad-modes-menu
  '( ( ( "FLT"   calc-normal-notation
	         (progn calc-num-prefix calc-normal-notation) )
       ( "FIX"   (progn 2 calc-fix-notation)
	         (progn calc-num-prefix calc-fix-notation) )
       ( "SCI"   calc-sci-notation
	         (progn calc-num-prefix calc-sci-notation) )
       ( "ENG"   calc-eng-notation
	         (progn calc-num-prefix calc-eng-notation) )
       ( "GRP"   calc-group-digits "\C-u-3\excalc-group-digits\r" )
       ( ""	 nil ) )
     ( ( "RAD"   calc-radians-mode )
       ( "DEG"   calc-degrees-mode )
       ( "FRAC"  calc-frac-mode )
       ( "POLR"  calc-polar-mode )
       ( "SYMB"	 calc-symbolic-mode )
       ( "PREC"  calc-precision ) )
     ( ( "SWAP"  calc-roll-down )
       ( "RLL3"  (progn 3 calc-roll-up) (progn 3 calc-roll-down) )
       ( "RLL4"  (progn 4 calc-roll-up) (progn 4 calc-roll-down) )
       ( "OVER"  calc-over )
       ( "STO"   calc-keypad-store )
       ( "RCL"   calc-keypad-recall ) ) ))

(define-derived-mode calc-keypad-mode fundamental-mode "Calculator"
  "Major mode for Calc keypad input."
  (define-key calc-keypad-mode-map " " 'calc-keypad-press)
  (define-key calc-keypad-mode-map (kbd "RET") 'calc-keypad-press)
  (define-key calc-keypad-mode-map (kbd "TAB") 'calc-keypad-menu)
  (define-key calc-keypad-mode-map "q" 'calc-keypad-off)
  (define-key calc-keypad-mode-map [down-mouse-1] 'ignore)
  (define-key calc-keypad-mode-map [drag-mouse-1] 'ignore)
  (define-key calc-keypad-mode-map [double-mouse-1] 'ignore)
  (define-key calc-keypad-mode-map [triple-mouse-1] 'ignore)
  (define-key calc-keypad-mode-map [down-mouse-2] 'ignore)
  (define-key calc-keypad-mode-map [drag-mouse-2] 'ignore)
  (define-key calc-keypad-mode-map [double-mouse-2] 'ignore)
  (define-key calc-keypad-mode-map [triple-mouse-2] 'ignore)
  (define-key calc-keypad-mode-map [down-mouse-3] 'ignore)
  (define-key calc-keypad-mode-map [drag-mouse-3] 'ignore)
  (define-key calc-keypad-mode-map [double-mouse-3] 'ignore)
  (define-key calc-keypad-mode-map [triple-mouse-3] 'ignore)
  (define-key calc-keypad-mode-map [mouse-3] 'calc-keypad-right-click)
  (define-key calc-keypad-mode-map [mouse-2] 'calc-keypad-middle-click)
  (define-key calc-keypad-mode-map [mouse-1] 'calc-keypad-left-click)
  (put 'calc-keypad-mode 'mode-class 'special)
  (make-local-variable 'calc-main-buffer))

(defun calc-do-keypad (&optional full-display interactive)
  (calc-create-buffer)
  (let ((calcbuf (current-buffer)))
    (unless (bufferp calc-keypad-buffer)
      (set-buffer (setq calc-keypad-buffer (get-buffer-create "*Calc Keypad*")))
      (calc-keypad-mode)
      (setq calc-main-buffer calcbuf)
      (calc-keypad-redraw)
      (calc-trail-buffer))
    (let ((width 29)
	  (height 17)
	  win old-win)
      (if (setq win (get-buffer-window "*Calculator*"))
	  (delete-window win))
      (if (setq win (get-buffer-window "*Calc Trail*"))
	  (if (one-window-p)
	      (switch-to-buffer (other-buffer))
	    (delete-window win)))
      (if (setq win (get-buffer-window calc-keypad-buffer))
	  (progn
	    (bury-buffer "*Calculator*")
	    (bury-buffer "*Calc Trail*")
	    (bury-buffer calc-keypad-buffer)
	    (if (one-window-p)
		(switch-to-buffer (other-buffer))
	      (delete-window win)))
	(setq calc-was-keypad-mode t
	      old-win (get-largest-window))
	(if (or (< (window-height old-win) (+ height 6))
		(< (window-width old-win) (+ width 15))
		full-display)
	    (delete-other-windows old-win))
	(if (< (window-height old-win) (+ height 4))
	    (error "Screen is not tall enough for this mode"))
	(if full-display
	    (progn
	      (setq win (split-window old-win (- (window-height old-win)
						 height 1)))
	      (set-window-buffer old-win (calc-trail-buffer))
	      (set-window-buffer win calc-keypad-buffer)
	      (set-window-start win 1)
	      (setq win (split-window win (+ width 3) t))
	      (set-window-buffer win calcbuf))
	  (if (or t  ; left-side keypad not yet fully implemented
		  (< (save-excursion
		       (set-buffer (window-buffer old-win))
		       (current-column))
		     (/ (window-width) 2)))
	      (setq win (split-window old-win (- (window-width old-win)
						 width 2)
				      t))
	    (setq old-win (split-window old-win (+ width 2) t)))
	  (set-window-buffer win calc-keypad-buffer)
	  (set-window-start win 1)
	  (split-window win (- (window-height win) height 1))
	  (set-window-buffer win calcbuf))
	(select-window old-win)
	(message "Welcome to GNU Emacs Calc!  Use the left and right mouse buttons")
	(run-hooks 'calc-keypad-start-hook)
	(and calc-keypad-said-hello interactive
	     (progn
	       (sit-for 2)
	       (message "")))
	(setq calc-keypad-said-hello t)))
    (setq calc-keypad-input nil)))

(defun calc-keypad-off ()
  (interactive)
  (if calc-standalone-flag
      (save-buffers-kill-emacs nil)
    (calc-keypad)))

(defun calc-keypad-redraw ()
  (set-buffer calc-keypad-buffer)
  (setq buffer-read-only t)
  (setq calc-keypad-full-layout (append (symbol-value (nth calc-keypad-menu
							   calc-keypad-menus))
					calc-keypad-layout))
  (let ((buffer-read-only nil)
	(row calc-keypad-full-layout)
	(y 0))
    (erase-buffer)
    (insert "\n")
    (while row
      (let ((col (car row)))
	(while col
	  (let* ((key (car col))
		 (cwid (if (>= y 4)
			   5
			 (if (and (= y 3) (eq col (car row)))
			     (progn (setq col (cdr col)) 9)
			   4)))
		 (name (if (and calc-standalone-flag
				(eq (nth 1 key) 'calc-keypad-off))
			   "EXIT"
			 (if (> (length (car key)) cwid)
			     (substring (car key) 0 cwid)
			   (car key))))
		 (wid (length name))
		 (pad (- cwid (/ wid 2))))
	    (insert (make-string (/ (- cwid wid) 2) 32)
		    name
		    (make-string (/ (- cwid wid -1) 2) 32)
		    (if (equal name "MENU")
			(int-to-string (1+ calc-keypad-menu))
		      "|")))
	  (or (setq col (cdr col))
	      (insert "\n")))
	(insert (if (>= y 4)
		    "-----+-----+-----+-----+-----"
		  (if (= y 3)
		      "-----+---+-+--+--+-+---++----"
		    "----+----+----+----+----+----"))
		(if (= y 7) "+\n" "|\n"))
	(setq y (1+ y)
	      row (cdr row)))))
  (setq calc-keypad-prev-input t)
  (calc-keypad-show-input)
  (goto-char (point-min)))

(defun calc-keypad-show-input ()
  (or (equal calc-keypad-input calc-keypad-prev-input)
      (let ((buffer-read-only nil))
	(save-excursion
	  (goto-char (point-min))
	  (forward-line 1)
	  (delete-region (point-min) (point))
	  (if calc-keypad-input
	      (insert "Calc: " calc-keypad-input "\n")
	    (insert "----+-----Calc " calc-version "-----+----"
		    (int-to-string (1+ calc-keypad-menu))
		    "\n")))))
  (setq calc-keypad-prev-input calc-keypad-input))

(defun calc-keypad-press ()
  (interactive)
  (unless (eq major-mode 'calc-keypad-mode)
    (error "Must be in *Calc Keypad* buffer for this command"))
  (let* ((row (save-excursion
		(beginning-of-line)
		(count-lines (point-min) (point))))
	 (y (/ row 2))
	 (x (/ (current-column) (if (>= y 4) 6 5)))
	 radix frac inv
	 (hyp (with-current-buffer calc-main-buffer
		(setq radix calc-number-radix
		      frac calc-prefer-frac
		      inv calc-inverse-flag)
		calc-hyperbolic-flag))
	 (invhyp t)
	 (menu (symbol-value (nth calc-keypad-menu calc-keypad-menus)))
	 (input calc-keypad-input)
	 (iexpon (and input
		      (or (string-match "\\*[0-9]+\\.\\^" input)
			  (and (<= radix 14) (string-match "e" input)))
		      (match-end 0)))
	 (key (nth x (nth y calc-keypad-full-layout)))
	 (cmd (or (nth (if inv (if hyp 4 2) (if hyp 3 99)) key)
		  (setq invhyp nil)
		  (nth 1 key)))
	 (isstring (and (consp cmd) (stringp (car cmd))))
	 (calc-is-keypad-press t))
    (if invhyp (calc-wrapper))  ; clear Inv and Hyp flags
    (unwind-protect
	(cond ((or (null cmd)
		   (= (% row 2) 0))
	       (beep))
	      ((and (> (minibuffer-depth) 0))
	       (cond (isstring
		      (push (aref (car cmd) 0) unread-command-events))
		     ((eq cmd 'calc-pop)
		      (push ?\177 unread-command-events))
		     ((eq cmd 'calc-enter)
		      (push 13 unread-command-events))
		     ((eq cmd 'calc-undo)
		      (push 7 unread-command-events))
		     (t
		      (beep))))
	      ((and input (string-match "STO\\|RCL" input))
	       (cond ((and isstring (string-match "[0-9]" (car cmd)))
		      (setq calc-keypad-input nil)
		      (let ((var (intern (concat "var-q" (car cmd)))))
			(cond ((equal input "STO+") (calc-store-plus var))
			      ((equal input "STO-") (calc-store-minus var))
			      ((equal input "STO*") (calc-store-times var))
			      ((equal input "STO/") (calc-store-div var))
			      ((equal input "STO^") (calc-store-power var))
			      ((equal input "STOn") (calc-store-neg 1 var))
			      ((equal input "STO&") (calc-store-inv 1 var))
			      ((equal input "STO") (calc-store-into var))
			      (t (calc-recall var)))))
		     ((memq cmd '(calc-pop calc-undo))
		      (setq calc-keypad-input nil))
		     ((and (equal input "STO")
			   (setq frac (assq cmd '( ( calc-plus . "+" )
						   ( calc-minus . "-" )
						   ( calc-times . "*" )
						   ( calc-divide . "/" )
						   ( calc-power . "^")
						   ( calc-change-sign . "n")
						   ( calc-inv . "&") ))))
		      (setq calc-keypad-input (concat input (cdr frac))))
		     (t
		      (beep))))
	      (isstring
	       (setq cmd (car cmd))
	       (if (or (and (equal cmd ".")
			    input
			    (string-match "[.:e^]" input))
		       (and (equal cmd "e")
			    input
			    (or (and (<= radix 14) (string-match "e" input))
				(string-match "\\^\\|[-.:]\\'" input)))
		       (and (not (equal cmd "."))
			    (let ((case-fold-search nil))
			      (string-match cmd "0123456789ABCDEF"
					    (if (string-match
						 "[e^]" (or input ""))
						10 radix)))))
		   (beep)
		 (setq calc-keypad-input (concat
					  (and (/= radix 10)
					       (or (not input)
						   (equal input "-"))
					       (format "%d#" radix))
					  (and (or (not input)
						   (equal input "-"))
					       (or (and (equal cmd "e") "1")
						   (and (equal cmd ".")
							(if frac "1" "0"))))
					  input
					  (if (and (equal cmd ".") frac)
					      ":"
					    (if (and (equal cmd "e")
						     (or (not input)
							 (string-match
							  "#" input))
						     (> radix 14))
						(format "*%d.^" radix)
					      cmd))))))
	      ((and (eq cmd 'calc-change-sign)
		    input)
	       (let* ((epos (or iexpon 0))
		      (suffix (substring input epos)))
		 (setq calc-keypad-input (concat
					  (substring input 0 epos)
					  (if (string-match "\\`-" suffix)
					      (substring suffix 1)
					    (concat "-" suffix))))))
	      ((and (eq cmd 'calc-pop)
		    input)
	       (if (equal input "")
		   (beep)
		 (setq calc-keypad-input (substring input 0
						    (or (string-match
							 "\\*[0-9]+\\.\\^\\'"
							 input)
							-1)))))
	      ((and (eq cmd 'calc-undo)
		    input)
	       (setq calc-keypad-input nil))
	      (t
	       (if input
		   (let ((val (math-read-number input)))
		     (setq calc-keypad-input nil)
		     (if val
			 (calc-wrapper
			  (calc-push-list (list (calc-record
						 (calc-normalize val)))))
		       (or (equal input "")
			   (beep))
		       (setq cmd nil))
		     (if (eq cmd 'calc-enter) (setq cmd nil))))
	       (setq prefix-arg current-prefix-arg)
	       (if cmd
		   (if (and (consp cmd) (eq (car cmd) 'progn))
		       (while (setq cmd (cdr cmd))
			 (if (integerp (car cmd))
			     (setq prefix-arg (car cmd))
			   (command-execute (car cmd))))
		     (command-execute cmd)))))
      (set-buffer calc-keypad-buffer)
      (calc-keypad-show-input))))

(defun calc-keypad-left-click (event)
  "Handle a left-button mouse click in Calc Keypad window."
  (interactive "e")
  (with-current-buffer calc-keypad-buffer
    (goto-char (posn-point (event-start event)))
    (calc-keypad-press)))

(defun calc-keypad-right-click (event)
  "Handle a right-button mouse click in Calc Keypad window."
  (interactive "e")
  (save-excursion
    (set-buffer calc-keypad-buffer)
    (calc-keypad-menu)))

(defun calc-keypad-middle-click (event)
  "Handle a middle-button mouse click in Calc Keypad window."
  (interactive "e")
  (with-current-buffer calc-keypad-buffer
    (calc-keypad-menu-back)))

(defun calc-keypad-menu ()
  (interactive)
  (unless (eq major-mode 'calc-keypad-mode)
    (error "Must be in *Calc Keypad* buffer for this command"))
  (while (progn (setq calc-keypad-menu (% (1+ calc-keypad-menu)
					  (length calc-keypad-menus)))
		(not (symbol-value (nth calc-keypad-menu calc-keypad-menus)))))
  (calc-keypad-redraw))

(defun calc-keypad-menu-back ()
  (interactive)
  (or (eq major-mode 'calc-keypad-mode)
      (error "Must be in *Calc Keypad* buffer for this command"))
  (while (progn (setq calc-keypad-menu (% (1- (+ calc-keypad-menu
						 (length calc-keypad-menus)))
					  (length calc-keypad-menus)))
		(not (symbol-value (nth calc-keypad-menu calc-keypad-menus)))))
  (calc-keypad-redraw))

(defun calc-keypad-store ()
  (interactive)
  (setq calc-keypad-input "STO"))

(defun calc-keypad-recall ()
  (interactive)
  (setq calc-keypad-input "RCL"))

(defun calc-pack-interval (mode)
  (interactive "p")
  (if (or (< mode 0) (> mode 3))
      (error "Open/close code should be in the range from 0 to 3"))
  (calc-pack (- -6 mode)))

(defun calc-keypad-execute ()
  (interactive)
  (let* ((prompt "Calc keystrokes: ")
	 (flush 'x-flush-mouse-queue)
	 (prefix nil)
	 keys cmd)
    (save-excursion
      (calc-select-buffer)
      (while (progn
	       (setq keys (read-key-sequence prompt))
	       (setq cmd (key-binding keys))
	       (if (or (memq cmd '(calc-inverse
				   calc-hyperbolic
				   universal-argument
				   digit-argument
				   negative-argument))
		       (and prefix (string-match "\\`\e?[-0-9]\\'" keys)))
		   (progn
		     (setq last-command-char (aref keys (1- (length keys))))
		     (command-execute cmd)
		     (setq flush 'not-any-more
			   prefix t
			   prompt (concat prompt (key-description keys) " ")))
		 (eq cmd flush)))))  ; skip mouse-up event
    (message "")
    (if (commandp cmd)
	(command-execute cmd)
      (error "Not a Calc command: %s" (key-description keys)))))

(provide 'calc-keypd)

;;; arch-tag: 4ba0d360-2bb6-40b8-adfa-eb373765b3f9
;;; calc-keypd.el ends here