home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / interfaces / mity-mouse / mouse-help.el < prev    next >
Encoding:
Text File  |  1993-03-28  |  5.1 KB  |  133 lines
  1. ; Module to get a buffer with a readable description of the mouse key
  2. ; bindings.
  3. ;
  4. ; tahorsley@ssd.csd.harris.com (Tom Horsley)
  5. ; Dec 26, 1989
  6. ;
  7. ; To actually bind a function to some mouse key use:
  8. ; (define-key mouse-map x-button-right 'func)
  9. ; ...
  10. ;
  11. ; Where x-button-right can be replaced with any of the names below:
  12.  
  13. (require 'x-mouse)
  14.  
  15. (defvar x-button-description
  16.    '(
  17.       (x-button-right           . "right button down")
  18.       (x-button-right-up        . "right button up")
  19.       (x-button-middle          . "middle button down")
  20.       (x-button-middle-up       . "middle button up")
  21.       (x-button-left            . "left button down")
  22.       (x-button-left-up         . "left button up")
  23.  
  24.       (x-button-s-right         . "<Shift> right button down")
  25.       (x-button-s-right-up      . "<Shift> right button up")
  26.       (x-button-s-middle        . "<Shift> middle button down")
  27.       (x-button-s-middle-up     . "<Shift> middle button up")
  28.       (x-button-s-left          . "<Shift> left button down")
  29.       (x-button-s-left-up       . "<Shift> left button up")
  30.  
  31.       (x-button-m-right         . "<Meta> right button down")
  32.       (x-button-m-right-up      . "<Meta> right button up")
  33.       (x-button-m-middle        . "<Meta> middle button down")
  34.       (x-button-m-middle-up     . "<Meta> middle button up")
  35.       (x-button-m-left          . "<Meta> left button down")
  36.       (x-button-m-left-up       . "<Meta> left button up")
  37.  
  38.       (x-button-c-right         . "<Ctrl> right button down")
  39.       (x-button-c-right-up      . "<Ctrl> right button up")
  40.       (x-button-c-middle        . "<Ctrl> middle button down")
  41.       (x-button-c-middle-up     . "<Ctrl> middle button up")
  42.       (x-button-c-left          . "<Ctrl> left button down")
  43.       (x-button-c-left-up       . "<Ctrl> left button up")
  44.  
  45.       (x-button-m-s-right       . "<Meta-Shift> right button down")
  46.       (x-button-m-s-right-up    . "<Meta-Shift> right button up")
  47.       (x-button-m-s-middle      . "<Meta-Shift> middle button down")
  48.       (x-button-m-s-middle-up   . "<Meta-Shift> middle button up")
  49.       (x-button-m-s-left        . "<Meta-Shift> left button down")
  50.       (x-button-m-s-left-up     . "<Meta-Shift> left button up")
  51.  
  52.       (x-button-c-s-right       . "<Ctrl-Shift> right button down")
  53.       (x-button-c-s-right-up    . "<Ctrl-Shift> right button up")
  54.       (x-button-c-s-middle      . "<Ctrl-Shift> middle button down")
  55.       (x-button-c-s-middle-up   . "<Ctrl-Shift> middle button up")
  56.       (x-button-c-s-left        . "<Ctrl-Shift> left button down")
  57.       (x-button-c-s-left-up     . "<Ctrl-Shift> left button up")
  58.  
  59.       (x-button-c-m-right       . "<Ctrl-Meta> right button down")
  60.       (x-button-c-m-right-up    . "<Ctrl-Meta> right button up")
  61.       (x-button-c-m-middle      . "<Ctrl-Meta> middle button down")
  62.       (x-button-c-m-middle-up   . "<Ctrl-Meta> middle button up")
  63.       (x-button-c-m-left        . "<Ctrl-Meta> left button down")
  64.       (x-button-c-m-left-up     . "<Ctrl-Meta> left button up")
  65.  
  66.       (x-button-c-m-s-right     . "<Ctrl-Meta-Shift> right button down")
  67.       (x-button-c-m-s-right-up  . "<Ctrl-Meta-Shift> right button up")
  68.       (x-button-c-m-s-middle    . "<Ctrl-Meta-Shift> middle button down")
  69.       (x-button-c-m-s-middle-up . "<Ctrl-Meta-Shift> middle button up")
  70.       (x-button-c-m-s-left      . "<Ctrl-Meta-Shift> left button down")
  71.       (x-button-c-m-s-left-up   . "<Ctrl-Meta-Shift> left button up")
  72.    )
  73. )
  74.  
  75. ; Add to help-map under the "x" key (for x-windows, of course)
  76. (define-key help-map "x" 'mouse-help)
  77.  
  78. (defun mouse-help ()
  79. "Display reasonable description of mouse-map."
  80.    (interactive)
  81.    (let
  82.       (
  83.          (b-desc x-button-description)
  84.          m-fun
  85.          k-desc
  86.          (h-buf (get-buffer-create "*Help*"))
  87.          p-buf
  88.          m-ndx
  89.          (local-map-buffer (current-buffer))
  90.       )
  91.       (save-excursion
  92.          (set-buffer h-buf)
  93.          (erase-buffer)
  94.          (while b-desc
  95.             (setq m-ndx (string-to-char (symbol-value (car (car b-desc)))))
  96.             (setq m-fun (aref mouse-map m-ndx))
  97.             (if (eq m-fun 'x-mouse-route-click)
  98.                ; This is a split mouse map, go look at local-mouse-map then
  99.                ; global-mouse-map if local was nil.
  100.                (progn
  101.                   (save-excursion
  102.                      (set-buffer local-map-buffer)
  103.                      (setq m-fun (aref local-mouse-map m-ndx))
  104.                   )
  105.                   (if m-fun
  106.                      nil
  107.                      (setq m-fun (aref global-mouse-map m-ndx))
  108.                   )
  109.                )
  110.             )
  111.             (setq k-desc (cdr (car b-desc)))
  112.             (setq b-desc (cdr b-desc))
  113.             (if (and m-fun (not (eq m-fun 'x-mouse-ignore)))
  114.                (let
  115.                   (
  116.                      (doc (documentation m-fun))
  117.                   )
  118.                   (if doc
  119.                      (progn
  120.                         (insert "Function ")
  121.                         (princ m-fun h-buf)
  122.                         (insert " bound to " k-desc ":\n" doc "\n\n")
  123.                      )
  124.                   )
  125.                )
  126.             )
  127.          )
  128.          (goto-char (point-min))
  129.       )
  130.       (display-buffer h-buf)
  131.    )
  132. )
  133.