home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.004 / xemacs-1 / xemacs-19.13 / lisp / hyperbole / hmouse-reg.el < prev    next >
Encoding:
Text File  |  1995-04-17  |  11.8 KB  |  290 lines
  1. ;;!emacs
  2. ;;
  3. ;; FILE:         hmouse-reg.el
  4. ;; SUMMARY:      System-dependent Smart Mouse Key bindings (no shift key).
  5. ;; USAGE:        GNU Emacs Lisp Library
  6. ;; KEYWORDS:     hypermedia, mouse
  7. ;;
  8. ;; AUTHOR:       Bob Weiner
  9. ;; ORG:          Brown U.
  10. ;;
  11. ;; ORIG-DATE:     3-Sep-91 at 21:40:58
  12. ;; LAST-MOD:     14-Apr-95 at 16:06:33 by Bob Weiner
  13. ;;
  14. ;; This file is part of Hyperbole.
  15. ;; Available for use and distribution under the same terms as GNU Emacs.
  16. ;;
  17. ;; Copyright (C) 1991-1995, Free Software Foundation, Inc.
  18. ;; Developed with support from Motorola Inc.
  19. ;;
  20. ;; DESCRIPTION:  
  21. ;;
  22. ;;   See description in "hmouse-key.el".
  23. ;;
  24. ;; DESCRIP-END.
  25.  
  26. ;;; ************************************************************************
  27. ;;; Public functions
  28. ;;; ************************************************************************
  29.  
  30. (defun hmouse-get-bindings ()
  31.   "Returns list of bindings for mouse keys prior to their use as Smart Keys."
  32.   (eval
  33.     (cdr (assoc
  34.        hyperb:window-system
  35.        '(("emacs19" .
  36.           (mapcar (function
  37.                (lambda (key) (cons key (lookup-key global-map key))))
  38.               (if (memq window-system '(ns dps))
  39.               ;; NEXTSTEP offers only 2 mouse buttons which we use
  40.               ;; as the Smart Keys.  We move the mouse-set-point
  41.               ;; command to shift-left.
  42.               '([down-mouse-1] [mouse-1] [down-mouse-2] [mouse-2]
  43.                 [double-mouse-1] [triple-mouse-1]
  44.                 [double-mouse-2] [triple-mouse-2]
  45.                 [vertical-line down-mouse-1] [vertical-line mouse-1]
  46.                 [vertical-line down-mouse-2] [vertical-line mouse-2]
  47.                 [mode-line down-mouse-1] [mode-line mouse-1]
  48.                 [mode-line down-mouse-2] [mode-line mouse-2]
  49.                 [S-mouse-1]
  50.                 )
  51.             ;; X
  52.             '([down-mouse-2] [mouse-2] [down-mouse-3] [mouse-3]
  53.               [double-mouse-2] [triple-mouse-2]
  54.               [double-mouse-3] [triple-mouse-3]
  55.               [vertical-line down-mouse-2] [vertical-line mouse-2]
  56.               [vertical-line down-mouse-3] [vertical-line mouse-3]
  57.               [mode-line down-mouse-2] [mode-line mouse-2]
  58.               [mode-line down-mouse-3] [mode-line mouse-3]
  59.               ))))
  60.          ("lemacs" .
  61.           (nconc
  62.         (mapcar (function
  63.               (lambda (key)
  64.                 (cons key (lookup-key global-map key))))
  65.             '([button2] [button2up] [button3] [button3up]))
  66.         (if (boundp 'mode-line-map)
  67.             (mapcar (function
  68.                   (lambda (key)
  69.                 (cons key (lookup-key mode-line-map key))))
  70.                 '([button3] [button3up])))))
  71.          ("xterm" .
  72.           (mapcar (function
  73.             (lambda (key) (cons key (lookup-key mouse-map key))))
  74.               (list x-button-middle x-button-middle-up
  75.                 x-button-right  x-button-right-up)))
  76.          ("epoch" .
  77.           (mapcar (function
  78.             (lambda (key) (cons key (aref mouse::global-map key))))
  79.               (list (mouse::index mouse-middle mouse-down)
  80.                 (mouse::index mouse-middle mouse-up)
  81.                 (mouse::index mouse-right mouse-down)
  82.                 (mouse::index mouse-right mouse-up)
  83.                 ;; Modeline mouse map
  84.                 (mouse::index mouse-mode-middle mouse-down)
  85.                 (mouse::index mouse-mode-middle mouse-up)
  86.                 (mouse::index mouse-mode-right mouse-down)
  87.                 (mouse::index mouse-mode-right mouse-up)
  88.                 )))
  89.          ("next" .
  90.           (mapcar (function
  91.             (lambda (key)
  92.               (cons key (mousemap-get
  93.                       (mouse-list-to-mouse-code key)
  94.                       current-global-mousemap))))
  95.               (apply 'nconc
  96.                  (mapcar (function
  97.                        (lambda (region)
  98.                      (mapcar (function
  99.                            (lambda (key)
  100.                              (cons region key)))
  101.                          '((left) (up left) (shift left)
  102.                            (right) (up right)
  103.                            ))))
  104.                      '(text scrollbar modeline minibuffer)))
  105.               ))
  106.          ;; SunView
  107.          ("sun" .
  108.           (mapcar (function
  109.             (lambda (key)
  110.               (setq key (mouse-list-to-mouse-code key))
  111.               (cons key (mousemap-get
  112.                       key current-global-mousemap))))
  113.               (apply 'nconc
  114.                  (mapcar (function
  115.                        (lambda (region)
  116.                      (mapcar (function
  117.                            (lambda (key)
  118.                              (cons region key)))
  119.                          '((middle) (up middle)
  120.                            (right) (up right)
  121.                            ))))
  122.                      '(text scrollbar modeline minibuffer)))
  123.               ))
  124.          ("apollo" .
  125.           (mapcar (function
  126.             (lambda (key-str) (apollo-mouse-key-and-binding
  127.                         key-str)))
  128.               '("M2D" "M2U" "M3D" "M3U")))
  129.          )))))
  130.  
  131. (defun hmouse-setup ()
  132.   "Binds mouse keys for use as Smart Keys."
  133.   (interactive)
  134.   (or hmouse-bindings-flag hmouse-previous-bindings
  135.       (setq hmouse-previous-bindings (hmouse-get-bindings)))
  136.   ;; Ensure Gillespie's Info mouse support is off since
  137.   ;; Hyperbole handles that.
  138.   (setq Info-mouse-support nil)
  139.   ;;
  140.   (cond ;; GNU Emacs 19
  141.         ((equal hyperb:window-system "emacs19")
  142.      (setq hmouse-set-point-command 'mouse-set-point)
  143.      ;; Get rid of Info-mode [mouse-2] binding since Hyperbole performs
  144.      ;; a superset of what it does.
  145.      (add-hook 'Info-mode-hook
  146.            (function (lambda () (define-key Info-mode-map [mouse-2] nil))))
  147.      ;;
  148.      (if (memq window-system '(ns dps))
  149.          ;; NEXTSTEP offers only 2 mouse buttons which we use
  150.          ;; as the Smart Keys.  We move the mouse-set-point
  151.          ;; command to shift-left.
  152.          (progn
  153.            (global-set-key [S-down-mouse-1]      'mouse-drag-region)
  154.            (global-set-key [S-mouse-1]           'mouse-set-point)
  155.            (global-set-key [down-mouse-1]        'action-key-depress-emacs19)
  156.            (global-set-key [mouse-1]             'action-mouse-key-emacs19)
  157.            (global-set-key [double-mouse-1]      'action-mouse-key-emacs19)
  158.            (global-set-key [triple-mouse-1]      'action-mouse-key-emacs19)
  159.            (global-set-key [down-mouse-2]        'assist-key-depress-emacs19)
  160.            (global-set-key [mouse-2]             'assist-mouse-key-emacs19)
  161.            (global-set-key [double-mouse-2]      'assist-mouse-key-emacs19)
  162.            (global-set-key [triple-mouse-2]      'assist-mouse-key-emacs19)
  163.            (global-set-key [vertical-line down-mouse-1] 'action-key-depress-emacs19)
  164.            (global-set-key [vertical-line mouse-1] 'action-mouse-key-emacs19)
  165.            (global-set-key [vertical-line down-mouse-2] 'assist-key-depress-emacs19)
  166.            (global-set-key [vertical-line mouse-2] 'assist-mouse-key-emacs19)
  167.            (global-set-key [mode-line down-mouse-2] 'action-key-depress-emacs19)
  168.            (global-set-key [mode-line mouse-2]      'action-mouse-key-emacs19)
  169.            (global-set-key [mode-line down-mouse-3] 'assist-key-depress-emacs19)
  170.            (global-set-key [mode-line mouse-3]   'assist-mouse-key-emacs19))
  171.        ;; X
  172.        (global-set-key [down-mouse-2]           'action-key-depress-emacs19)
  173.        (global-set-key [mouse-2]                'action-mouse-key-emacs19)
  174.        (global-set-key [double-mouse-2]         'action-mouse-key-emacs19)
  175.        (global-set-key [triple-mouse-2]         'action-mouse-key-emacs19)
  176.        (global-set-key [down-mouse-3]           'assist-key-depress-emacs19)
  177.        (global-set-key [mouse-3]                'assist-mouse-key-emacs19)
  178.        (global-set-key [double-mouse-3]         'assist-mouse-key-emacs19)
  179.        (global-set-key [triple-mouse-3]         'assist-mouse-key-emacs19)
  180.        (global-set-key [vertical-line down-mouse-2] 'action-key-depress-emacs19)
  181.        (global-set-key [vertical-line mouse-2]      'action-mouse-key-emacs19)
  182.        (global-set-key [vertical-line down-mouse-3] 'assist-key-depress-emacs19)
  183.        (global-set-key [vertical-line mouse-3]      'assist-mouse-key-emacs19)
  184.        (global-set-key [mode-line down-mouse-2] 'action-key-depress-emacs19)
  185.        (global-set-key [mode-line mouse-2]      'action-mouse-key-emacs19)
  186.        (global-set-key [mode-line down-mouse-3] 'assist-key-depress-emacs19)
  187.        (global-set-key [mode-line mouse-3]      'assist-mouse-key-emacs19)))
  188.     ;;
  189.     ;; XEmacs
  190.     ((equal hyperb:window-system "lemacs")
  191.      (setq hmouse-set-point-command 'hmouse-move-point-xemacs)
  192.      ;; Get rid of Info-mode buttons 2 and 3 bindings since Hyperbole handles
  193.      ;; things in Info.
  194.      (add-hook 'Info-mode-hook
  195.            (function (lambda () (define-key Info-mode-map 'button2 nil))))
  196.      ;;
  197.      (global-set-key 'button2     'action-key-depress)
  198.      (global-set-key 'button2up   'action-mouse-key)
  199.      (if (fboundp 'infodock-set-mouse-bindings)
  200.          (infodock-set-mouse-bindings)
  201.        (let ((unbind-but3
  202.           (function (lambda () (define-key Info-mode-map 'button3 nil)))))
  203.          (if (and (boundp 'Info-mode-map) (keymapp Info-mode-map))
  204.          (funcall unbind-but3)
  205.            (add-hook 'Info-mode-hook unbind-but3)))
  206.        (if (boundp 'mode-line-map)
  207.            (progn (define-key mode-line-map 'button3   'assist-key-depress)
  208.               (define-key mode-line-map 'button3up 'assist-mouse-key)
  209.               ))
  210.        (global-set-key 'button3     'assist-key-depress)
  211.        (global-set-key 'button3up   'assist-mouse-key)))
  212.     ;;
  213.     ;; X
  214.     ((equal hyperb:window-system "xterm")
  215.      (setq hmouse-set-point-command 'x-mouse-set-point)
  216.      (define-key mouse-map x-button-middle 'action-key-depress)
  217.      (define-key mouse-map x-button-middle-up 'action-mouse-key)
  218.      (define-key mouse-map x-button-right 'assist-key-depress)
  219.      (define-key mouse-map x-button-right-up 'assist-mouse-key)
  220.      ;; Use these instead of the above for a true META-BUTTON binding.
  221.      ;; (define-key mouse-map x-button-m-middle 'assist-key-depress)
  222.      ;; (define-key mouse-map x-button-m-middle-up 'assist-mouse-key)
  223.      )
  224.     ;;
  225.     ;; Epoch
  226.     ((equal hyperb:window-system "epoch")
  227.      (setq hmouse-set-point-command 'mouse::set-point)
  228.      (global-set-mouse mouse-middle mouse-down  'action-key-depress)
  229.      (global-set-mouse mouse-middle mouse-up    'action-mouse-key)
  230.      (global-set-mouse mouse-right  mouse-down  'assist-key-depress)
  231.      (global-set-mouse mouse-right  mouse-up    'assist-mouse-key)
  232.      ;; Modeline mouse map
  233.      (global-set-mouse mouse-mode-middle mouse-down  'action-key-depress)
  234.      (global-set-mouse mouse-mode-middle mouse-up    'action-mouse-key)
  235.      (global-set-mouse mouse-mode-right  mouse-down  'assist-key-depress)
  236.      (global-set-mouse mouse-mode-right  mouse-up    'assist-mouse-key)
  237.      )
  238.     ;;
  239.     ;; NeXT
  240.     ((equal hyperb:window-system "next")
  241.      (setq hmouse-set-point-command 'hmouse-move-point-eterm)
  242.      ;; Use shift-left button to set point.
  243.      ;; Use left button instead of non-existent middle as Smart Key.
  244.      (mapcar
  245.       (function
  246.        (lambda (region)
  247.          (global-set-mouse (cons region '(shift left)) 'mouse-move-point)
  248.          (global-set-mouse (cons region '(left))       'action-key-depress)
  249.          (global-set-mouse (cons region '(up left))    'action-mouse-key)
  250.          (global-set-mouse (cons region '(right))      'assist-key-depress)
  251.          (global-set-mouse (cons region '(up right))   'assist-mouse-key)
  252.          ;; Use these instead of the above for a true META-BUTTON binding.
  253.          ;; (global-set-mouse (cons region '(meta    right)) 'assist-key-depress)
  254.          ;; (global-set-mouse (cons region '(meta up right)) 'assist-mouse-key)
  255.          ))
  256.       '(text scrollbar modeline minibuffer))
  257.      )
  258.     ;;
  259.     ;; SunView
  260.     ((equal hyperb:window-system "sun")
  261.      (setq hmouse-set-point-command 'hmouse-move-point-eterm)
  262.      (mapcar
  263.       (function
  264.        (lambda (region)
  265.          (global-set-mouse (cons region '(middle))     'action-key-depress)
  266.          (global-set-mouse (cons region '(up middle))  'action-mouse-key)
  267.          (global-set-mouse (cons region '(right))      'assist-key-depress)
  268.          (global-set-mouse (cons region '(up right))   'assist-mouse-key)
  269.          ;; Use these instead of the above for a true META-BUTTON binding.
  270.          ;; (global-set-mouse (cons region '(meta    middle)) 'assist-key-depress)
  271.          ;; (global-set-mouse (cons region '(meta up middle)) 'assist-mouse-key)
  272.          ))
  273.       '(text scrollbar modeline minibuffer))
  274.      )
  275.     ;;
  276.     ;; Apollo DM
  277.     ((equal hyperb:window-system "apollo")
  278.      (setq hmouse-set-point-command 'apollo-mouse-move-point)
  279.      (bind-apollo-mouse-button "M2D" 'action-key-depress)
  280.      (bind-apollo-mouse-button "M2U" 'action-mouse-key)
  281.      (bind-apollo-mouse-button "M3D" 'assist-key-depress)
  282.      (bind-apollo-mouse-button "M3U" 'assist-mouse-key)
  283.      ;; Use these instead of the above for a true META-BUTTON binding.
  284.      ;; (bind-apollo-mouse-button "M2U" 'action-mouse-key
  285.      ;;  'assist-mouse-key)
  286.      ;; (bind-apollo-mouse-button "M2D" 'action-key-depress 'assist-key-depress)
  287.      ))
  288.   (setq hmouse-bindings (hmouse-get-bindings)
  289.     hmouse-bindings-flag t))
  290.