/[emacs]/emacs/lisp/calc/calc-keypd.el
ViewVC logotype

Diff of /emacs/lisp/calc/calc-keypd.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by eliz, Tue Nov 6 18:59:06 2001 UTC revision 1.2 by eliz, Mon Nov 12 11:39:45 2001 UTC
# Line 1  Line 1 
1  ;; Calculator for GNU Emacs, part II [calc-keypd.el]  ;; Calculator for GNU Emacs, part II [calc-keypd.el]
2  ;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc.  ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
3  ;; Written by Dave Gillespie, daveg@synaptics.com.  ;; Written by Dave Gillespie, daveg@synaptics.com.
4    
5  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
# Line 30  Line 30 
30    
31    
32    
33  ;;; Pictorial interface to Calc using the X window system mouse.  ;;; Pictorial interface to Calc using a mouse.
34    
35  (defvar calc-keypad-buffer nil)  (defvar calc-keypad-buffer nil)
36  (defvar calc-keypad-menu 0)  (defvar calc-keypad-menu 0)
37  (defvar calc-keypad-full-layout nil)  (defvar calc-keypad-full-layout nil)
38  (defvar calc-keypad-input nil)  (defvar calc-keypad-input nil)
39  (defvar calc-keypad-prev-input nil)  (defvar calc-keypad-prev-input nil)
 (defvar calc-keypad-prev-x-left-click nil)  
 (defvar calc-keypad-prev-x-middle-click nil)  
 (defvar calc-keypad-prev-x-right-click nil)  
40  (defvar calc-keypad-said-hello nil)  (defvar calc-keypad-said-hello nil)
41    
42  (defvar calc-keypad-map nil)  (defvar calc-keypad-map nil)
43  (if calc-keypad-map  (unless calc-keypad-map
44      ()    (let ((map (make-sparse-keymap)))
45    (setq calc-keypad-map (make-sparse-keymap))      (define-key map " " 'calc-keypad-press)
46    (define-key calc-keypad-map " " 'calc-keypad-press)      (define-key map (kbd "RET") 'calc-keypad-press)
47    (define-key calc-keypad-map "\r" 'calc-keypad-press)      (define-key map (kbd "TAB") 'calc-keypad-menu)
48    (define-key calc-keypad-map "\t" 'calc-keypad-menu)      (define-key map "q" 'calc-keypad-off)
49    (define-key calc-keypad-map "q" 'calc-keypad-off))      (define-key map [(mouse-3)] 'calc-keypad-right-click)
50        (define-key map [(mouse-2)] 'calc-keypad-middle-click)
51        (define-key map [(mouse-1)] 'calc-keypad-left-click)
52        (setq calc-keypad-map map)))
53    
54  (defun calc-do-keypad (&optional full-display interactive)  (defun calc-do-keypad (&optional full-display interactive)
   (if (string-match "^19" emacs-version)  
       (error "Sorry, calc-keypad not yet implemented for Emacs 19"))  
55    (calc-create-buffer)    (calc-create-buffer)
56    (let ((calcbuf (current-buffer)))    (let ((calcbuf (current-buffer)))
57      (or (and calc-keypad-buffer      (unless (and calc-keypad-buffer
58               (buffer-name calc-keypad-buffer))                   (buffer-name calc-keypad-buffer))
59          (progn        (setq calc-keypad-buffer (get-buffer-create "*Calc Keypad*"))
60            (setq calc-keypad-buffer (get-buffer-create "*Calc Keypad*"))        (set-buffer calc-keypad-buffer)
61            (set-buffer calc-keypad-buffer)        (use-local-map calc-keypad-map)
62            (use-local-map calc-keypad-map)        (setq major-mode 'calc-keypad)
63            (setq major-mode 'calc-keypad)        (setq mode-name "Calculator")
64            (setq mode-name "Calculator")        (put 'calc-keypad 'mode-class 'special)
65            (put 'calc-keypad 'mode-class 'special)        (make-local-variable 'calc-main-buffer)
66            (make-local-variable 'calc-main-buffer)        (setq calc-main-buffer calcbuf)
67            (setq calc-main-buffer calcbuf)        (calc-keypad-redraw)
68            (calc-keypad-redraw)        (calc-trail-buffer))
           (calc-trail-buffer)))  
69      (let ((width 29)      (let ((width 29)
70            (height 17)            (height 17)
71            win old-win)            win old-win)
# Line 85  Line 82 
82              (bury-buffer calc-keypad-buffer)              (bury-buffer calc-keypad-buffer)
83              (if (one-window-p)              (if (one-window-p)
84                  (switch-to-buffer (other-buffer))                  (switch-to-buffer (other-buffer))
85                (delete-window win))                (delete-window win)))
             (if (and calc-keypad-prev-x-left-click  
                      (eq (aref mouse-map 0) 'calc-keypad-x-right-click)  
                      (eq (aref mouse-map 1) 'calc-keypad-x-middle-click)  
                      (eq (aref mouse-map 2) 'calc-keypad-x-left-click))  
                 (progn  
                   (aset mouse-map 0 calc-keypad-prev-x-right-click)  
                   (aset mouse-map 1 calc-keypad-prev-x-middle-click)  
                   (aset mouse-map 2 calc-keypad-prev-x-left-click)  
                   (setq calc-keypad-prev-x-left-click nil))))  
86          (setq calc-was-keypad-mode t          (setq calc-was-keypad-mode t
87                old-win (get-largest-window))                old-win (get-largest-window))
88          (if (or (< (window-height old-win) (+ height 6))          (if (or (< (window-height old-win) (+ height 6))
# Line 126  Line 114 
114            (split-window win (- (window-height win) height 1))            (split-window win (- (window-height win) height 1))
115            (set-window-buffer win calcbuf))            (set-window-buffer win calcbuf))
116          (select-window old-win)          (select-window old-win)
         (if (and (eq window-system 'x)  
                  (not calc-keypad-prev-x-left-click))  
             (progn  
               (setq calc-keypad-prev-x-right-click (aref mouse-map 0)  
                     calc-keypad-prev-x-middle-click (aref mouse-map 1)  
                     calc-keypad-prev-x-left-click (aref mouse-map 2))  
               (aset mouse-map 0 'calc-keypad-x-right-click)  
               (aset mouse-map 1 'calc-keypad-x-middle-click)  
               (aset mouse-map 2 'calc-keypad-x-left-click)))  
117          (message "Welcome to GNU Emacs Calc!  Use the left and right mouse buttons.")          (message "Welcome to GNU Emacs Calc!  Use the left and right mouse buttons.")
118          (run-hooks 'calc-keypad-start-hook)          (run-hooks 'calc-keypad-start-hook)
119          (and calc-keypad-said-hello interactive          (and calc-keypad-said-hello interactive
120               (progn               (progn
121                 (sit-for 2)                 (sit-for 2)
122                 (message "")))                 (message "")))
123          (setq calc-keypad-said-hello t))))          (setq calc-keypad-said-hello t)))
124    (setq calc-keypad-input nil)      (setq calc-keypad-input nil)))
 )  
125    
126  (defun calc-keypad-off ()  (defun calc-keypad-off ()
127    (interactive)    (interactive)
# Line 252  Line 230 
230                 (beep))                 (beep))
231                ((and (> (minibuffer-depth) 0))                ((and (> (minibuffer-depth) 0))
232                 (cond (isstring                 (cond (isstring
233                        (setq unread-command-char (aref (car cmd) 0)))                        (push (aref (car cmd) 0) unread-command-events))
234                       ((eq cmd 'calc-pop)                       ((eq cmd 'calc-pop)
235                        (setq unread-command-char ?\177))                        (push ?\177 unread-command-events))
236                       ((eq cmd 'calc-enter)                       ((eq cmd 'calc-enter)
237                        (setq unread-command-char 13))                        (push 13 unread-command-events))
238                       ((eq cmd 'calc-undo)                       ((eq cmd 'calc-undo)
239                        (setq unread-command-char 7))                        (push 7 unread-command-events))
240                       (t                       (t
241                        (beep))))                        (beep))))
242                ((and input (string-match "STO\\|RCL" input))                ((and input (string-match "STO\\|RCL" input))
# Line 368  Line 346 
346        (calc-keypad-show-input)))        (calc-keypad-show-input)))
347  )  )
348    
349  (defun calc-keypad-x-left-click (arg)  (defun calc-keypad-left-click (event)
350    "Handle a left-button mouse click in Calc Keypad window."    "Handle a left-button mouse click in Calc Keypad window."
351    (let (coords)    (interactive "e")
352      (if (and calc-keypad-buffer    (goto-char (posn-point (event-start event)))
353               (buffer-name calc-keypad-buffer)    (calc-keypad-press))
              (get-buffer-window calc-keypad-buffer)  
              (setq coords (coordinates-in-window-p  
                            arg (get-buffer-window calc-keypad-buffer))))  
         (let ((win (selected-window)))  
           (unwind-protect  
               (progn  
                 (x-mouse-set-point arg)  
                 (calc-keypad-press))  
             (and (window-point win)  
                  (select-window win))))  
       (funcall calc-keypad-prev-x-left-click arg)))  
 )  
354    
355  (defun calc-keypad-x-right-click (arg)  (defun calc-keypad-right-click (event)
356    "Handle a right-button mouse click in Calc Keypad window."    "Handle a right-button mouse click in Calc Keypad window."
357    (if (and calc-keypad-buffer    (interactive "e")
358             (buffer-name calc-keypad-buffer)    (save-excursion
359             (get-buffer-window calc-keypad-buffer)      (set-buffer calc-keypad-buffer)
360             (coordinates-in-window-p      (calc-keypad-menu)))
             arg (get-buffer-window calc-keypad-buffer)))  
       (save-excursion  
         (set-buffer calc-keypad-buffer)  
         (calc-keypad-menu))  
     (funcall calc-keypad-prev-x-right-click arg))  
 )  
361    
362  (defun calc-keypad-x-middle-click (arg)  (defun calc-keypad-middle-click (event)
363    "Handle a middle-button mouse click in Calc Keypad window."    "Handle a middle-button mouse click in Calc Keypad window."
364    (if (and calc-keypad-buffer    (interactive "e")
365             (buffer-name calc-keypad-buffer)    (with-current-buffer calc-keypad-buffer
366             (get-buffer-window calc-keypad-buffer)      (calc-keypad-menu-back)))
            (coordinates-in-window-p  
             arg (get-buffer-window calc-keypad-buffer)))  
       (save-excursion  
         (set-buffer calc-keypad-buffer)  
         (calc-keypad-menu-back))  
     (funcall calc-keypad-prev-x-middle-click arg))  
 )  
367    
368  (defun calc-keypad-menu ()  (defun calc-keypad-menu ()
369    (interactive)    (interactive)
370    (or (eq major-mode 'calc-keypad)    (unless (eq major-mode 'calc-keypad)
371        (error "Must be in *Calc Keypad* buffer for this command"))      (error "Must be in *Calc Keypad* buffer for this command"))
372    (while (progn (setq calc-keypad-menu (% (1+ calc-keypad-menu)    (while (progn (setq calc-keypad-menu (% (1+ calc-keypad-menu)
373                                            (length calc-keypad-menus)))                                            (length calc-keypad-menus)))
374                  (not (symbol-value (nth calc-keypad-menu calc-keypad-menus)))))                  (not (symbol-value (nth calc-keypad-menu calc-keypad-menus)))))

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26