home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / misc / sco-mouse.shar / mouse.el < prev   
Encoding:
Text File  |  1990-07-22  |  5.6 KB  |  153 lines
  1. ;; mouse.el - Gnu emacs mouse driver for SCO Xenix or Unix.  
  2. ;; Copyright 1990 Ronald Florence (ron@mlfarm, 5.20.90)
  3. ;; 
  4. ;; This is a rudimentary mouse-driver which reads mouse events from
  5. ;; an asynchronous process.  It doesn't really work very well.  I am
  6. ;; posting it in the hope that someone will adopt and educate the
  7. ;; little rodent.  At the very least, the driver needs:
  8. ;;
  9. ;;   1. Improved mouse-motions.  The current code naively treats
  10. ;;    mouse motions as cursor motions.
  11. ;;   2. Could use local mouse-maps set by mode-hooks instead of 
  12. ;;    binding the mouse buttons in set-mouse-mode.  (suggested 
  13. ;;    by John Robinson, jr@bbn.com)
  14. ;;   3. The module and the mouse functions need less generic names.
  15. ;;
  16. ;; To install:
  17. ;;
  18. ;;   1. Compile emacsmouse
  19. ;;         [g]cc -O emacsmouse.c -levent -o emacsmouse
  20. ;;    and install it in ../emacs/etc.
  21. ;;   2. Install mouse.el in ../emacs/lisp.
  22. ;;   3. Make sure the pty devices (ttyp0 - ttyp??) are listed in
  23. ;;    /usr/lib/event/ttys, with the appropriate mouse.  The mouse
  24. ;;    won't work unless you compiled emacs to use ptys for processes.
  25. ;;   4. Put the line 
  26. ;;         (autoload 'mouse "mouse" nil t)
  27. ;;    in your ~/.emacs or ../emacs/lisp/default.el file.
  28. ;;   5. Change the mouse button bindings, or add bindings for a third
  29. ;;    button, in set-mouse-mode.
  30. ;;  
  31. ;;  To start the mouse, do "M-x mouse".  The mouse should follow the
  32. ;;  cursor.  If the mouse is phlegmatic or hyperactive, kill it and 
  33. ;;  change the sensitivity before you start the mouse again.
  34.  
  35.  
  36. (provide 'mouse)
  37.  
  38. (defconst no-button "n")
  39. (defconst left-button "l")
  40. (defconst right-button "r")
  41. (defconst both-buttons "b")
  42. (defconst middle-button "c")
  43. (defconst all-buttons "a")
  44. (defconst left-middle-button "L")
  45. (defconst right-middle-button "R")
  46.  
  47. (defvar sensitivity 5 
  48.   "Sets mouse sensitivity.  The range is 1-9.")
  49.  
  50. (defvar mouse-process nil)
  51.  
  52. (defvar current-mouse-mode nil
  53.   "The major-mode of the current mouse buffer.")
  54.  
  55.  
  56. (defun mouse () 
  57. "Reads mouse buttons and position.  The default button 
  58. bindings in set-mouse-mode are
  59.  
  60. mode    left-button    right-button    both-buttons
  61. ----    -----------    ------------    ------------
  62. vm    next-message    scroll-message    quit-vm
  63. gnus    next-article    scroll-article    quit-newsgroup
  64. dired    mark-deleted    visit-file    execute-deletions
  65. buffer    mark-deleted    select-buffer    execute-deletions
  66. shell    copy-input    send-input    interrupt-shell-subjob
  67. default    set-mark    yank        kill-region "
  68.   (interactive)
  69.   (let ((live (and mouse-process
  70.            (eq (process-status mouse-process) 'run))))
  71.     (if (not live)
  72.     (save-excursion
  73.       (if mouse-process
  74.           (delete-process mouse-process))
  75.       (setq mouse-process
  76.         (start-process "mouse" nil "emacsmouse" 
  77.                 (int-to-string sensitivity)))
  78.       (process-kill-without-query mouse-process)
  79.       (set-process-sentinel mouse-process 'mouse-sentinel)
  80.       (set-process-filter mouse-process 'mouse-filter)))))
  81.  
  82.  
  83. (defun mouse-sentinel (proc reason)
  84.   (or (eq (process-status proc) 'run)
  85.       (message "The mouse died.")))
  86.  
  87.  
  88. (defun mouse-filter (proc string)
  89.   (or (eq current-mouse-mode major-mode) (set-mouse-mode))
  90.   (setq index 0
  91.     x-delta 0
  92.     y-delta 0
  93.     oldbutton nil)
  94.   (while 
  95.       (string-match "[abclrLRn][+---][0-9][0-9][+---][0-9][0-9]" string index)
  96.     (setq mouse-string (substring string (match-beginning 0))
  97.       button (substring mouse-string 0 1)
  98.       x-delta (string-to-int (substring mouse-string 1 4))
  99.       y-delta (string-to-int (substring mouse-string 4
  100.                       (if (> (length mouse-string) 7) 7 nil)))
  101.       index (+ index 7))
  102.     (cond ((> y-delta 0) (previous-line y-delta))
  103.     ((< y-delta 0) (next-line (- y-delta))))
  104.     (cond ((> x-delta 0) (forward-char x-delta))
  105.     ((< x-delta 0) (backward-char (- x-delta))))
  106.     (or (eq button oldbutton)
  107.     (call-interactively (lookup-key mouse-map button)))
  108.     (setq oldbutton button)))
  109.  
  110.  
  111. (or (keymapp mouse-map)
  112.     (setq mouse-map (make-sparse-keymap)))
  113.  
  114. (defun mouse-do-zip ()
  115.   "Doesn't do anything."
  116.   (interactive))
  117.  
  118. (defun set-mouse-mode ()
  119.   (setq current-mouse-mode major-mode)
  120.   (define-key mouse-map no-button 'mouse-do-zip)
  121.   (cond ((eq major-mode (or 'vm-mode 'vm-summary-mode))
  122.      (define-key mouse-map left-button 'vm-next-message)
  123.      (define-key mouse-map right-button 'vm-scroll-forward)
  124.      (define-key mouse-map both-buttons 'vm-quit))
  125.     ((eq major-mode 'gnus-Group-mode)
  126.      (define-key mouse-map left-button 'gnus-Group-select-group)
  127.      (define-key mouse-map right-button 'gnus-Group-read-group) 
  128.      (define-key mouse-map both-buttons 'gnus-Group-next-unread-group))
  129.     ((eq major-mode 'gnus-Subject-mode)
  130.      (define-key mouse-map left-button 'gnus-Subject-next-unread-article)
  131.      (define-key mouse-map right-button 'gnus-Subject-next-page)
  132.      (define-key mouse-map both-buttons 'gnus-Subject-exit))
  133.     ((eq major-mode 'gnus-Article-mode)
  134.      (define-key mouse-map left-button 'gnus-Subject-prev-page)
  135.      (define-key mouse-map right-button 'gnus-Article-next-page)
  136.      (define-key mouse-map both-buttons 'gnus-Subject-exit))
  137.     ((eq major-mode 'dired-mode)
  138.      (define-key mouse-map left-button 'dired-flag-file-deleted)
  139.      (define-key mouse-map right-button 'dired-find-file)
  140.      (define-key mouse-map both-buttons 'dired-do-deletions))
  141.     ((eq major-mode 'Buffer-menu-mode)
  142.      (define-key mouse-map left-button 'Buffer-menu-delete)
  143.      (define-key mouse-map right-button 'Buffer-menu-this-window)
  144.      (define-key mouse-map both-buttons 'Buffer-menu-execute))
  145.     ((eq major-mode 'shell-mode)
  146.      (define-key mouse-map left-button 'copy-last-shell-input)
  147.      (define-key mouse-map right-button 'shell-send-input)
  148.      (define-key mouse-map both-buttons 'interrupt-shell-subjob))
  149.     (t
  150.      (define-key mouse-map left-button 'set-mark-command)
  151.      (define-key mouse-map right-button 'yank)
  152.      (define-key mouse-map both-buttons 'kill-region))))
  153.