home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 4 / FreshFish_May-June1994.bin / bbs / gnu / emacs-18.59-bin.lha / lib / emacs / 18.59 / lisp / amiga-mouse.el < prev    next >
Lisp/Scheme  |  1992-11-21  |  12KB  |  277 lines
  1. ;; Mouse support for Amiga Intuition window system.
  2. ;; Copyright (C) 1985, 1987 Free Software Foundation, Inc.
  3.  
  4. ;; This file is part of GNU Emacs.
  5.  
  6. ;; GNU Emacs is distributed in the hope that it will be useful,
  7. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  8. ;; accepts responsibility to anyone for the consequences of using it
  9. ;; or for whether it serves any particular purpose or works at all,
  10. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  11. ;; License for full details.
  12.  
  13. ;; Everyone is granted permission to copy, modify and redistribute
  14. ;; GNU Emacs, but only under the conditions described in the
  15. ;; GNU Emacs General Public License.   A copy of this license is
  16. ;; supposed to have been given to you along with GNU Emacs so you
  17. ;; can know your rights and responsibilities.  It should be in a
  18. ;; file named COPYING.  Among other things, the copyright notice
  19. ;; and this notice must be preserved on all copies.
  20.  
  21. (provide 'amiga-mouse)
  22.  
  23. (defconst amiga-button-right (char-to-string 0))
  24. (defconst amiga-button-middle (char-to-string 1))
  25. (defconst amiga-button-left (char-to-string 2))
  26.  
  27. (defconst amiga-button-right-up (char-to-string 4))
  28. (defconst amiga-button-middle-up (char-to-string 5))
  29. (defconst amiga-button-left-up (char-to-string 6))
  30.  
  31. (defconst amiga-button-s-right (char-to-string 16))
  32. (defconst amiga-button-s-middle (char-to-string 17))
  33. (defconst amiga-button-s-left (char-to-string 18))
  34.  
  35. (defconst amiga-button-s-right-up (char-to-string 20))
  36. (defconst amiga-button-s-middle-up (char-to-string 21))
  37. (defconst amiga-button-s-left-up (char-to-string 22))
  38.  
  39. (defconst amiga-button-m-right (char-to-string 32))
  40. (defconst amiga-button-m-middle (char-to-string 33))
  41. (defconst amiga-button-m-left (char-to-string 34))
  42.  
  43. (defconst amiga-button-m-right-up (char-to-string 36))
  44. (defconst amiga-button-m-middle-up (char-to-string 37))
  45. (defconst amiga-button-m-left-up (char-to-string 38))
  46.  
  47. (defconst amiga-button-c-right (char-to-string 64))
  48. (defconst amiga-button-c-middle (char-to-string 65))
  49. (defconst amiga-button-c-left (char-to-string 66))
  50.  
  51. (defconst amiga-button-c-right-up (char-to-string 68))
  52. (defconst amiga-button-c-middle-up (char-to-string 69))
  53. (defconst amiga-button-c-left-up (char-to-string 70))
  54.  
  55. (defconst amiga-button-m-s-right (char-to-string 48))
  56. (defconst amiga-button-m-s-middle (char-to-string 49))
  57. (defconst amiga-button-m-s-left (char-to-string 50))
  58.  
  59. (defconst amiga-button-m-s-right-up (char-to-string 52))
  60. (defconst amiga-button-m-s-middle-up (char-to-string 53))
  61. (defconst amiga-button-m-s-left-up (char-to-string 54))
  62.  
  63. (defconst amiga-button-c-s-right (char-to-string 80))
  64. (defconst amiga-button-c-s-middle (char-to-string 81))
  65. (defconst amiga-button-c-s-left (char-to-string 82))
  66.  
  67. (defconst amiga-button-c-s-right-up (char-to-string 84))
  68. (defconst amiga-button-c-s-middle-up (char-to-string 85))
  69. (defconst amiga-button-c-s-left-up (char-to-string 86))
  70.  
  71. (defconst amiga-button-c-m-right (char-to-string 96))
  72. (defconst amiga-button-c-m-middle (char-to-string 97))
  73. (defconst amiga-button-c-m-left (char-to-string 98))
  74.  
  75. (defconst amiga-button-c-m-right-up (char-to-string 100))
  76. (defconst amiga-button-c-m-middle-up (char-to-string 101))
  77. (defconst amiga-button-c-m-left-up (char-to-string 102))
  78.  
  79. (defconst amiga-button-c-m-s-right (char-to-string 112))
  80. (defconst amiga-button-c-m-s-middle (char-to-string 113))
  81. (defconst amiga-button-c-m-s-left (char-to-string 114))
  82.  
  83. (defconst amiga-button-c-m-s-right-up (char-to-string 116))
  84. (defconst amiga-button-c-m-s-middle-up (char-to-string 117))
  85. (defconst amiga-button-c-m-s-left-up (char-to-string 118))
  86.  
  87. (defmacro cadr (x) (list 'car (list 'cdr x)))
  88. (defmacro caddr (x) (list 'car (list 'cdr (list 'cdr x))))
  89. (defmacro cadddr (x) (list 'car (list 'cdr (list 'cdr (list 'cdr x)))))
  90.  
  91. (defun coordinates-in-window-p (arg w)
  92.   (let ((x (car arg))
  93.     (y (cadr arg))
  94.     (edges (window-edges w)))
  95.     (and (>= x (car edges)) (< x (caddr edges))
  96.      (>= y (cadr edges)) (< y (cadddr edges))
  97.      (list (- x (car edges)) (- y (cadr edges))))))
  98.  
  99. (defvar amiga-process-mouse-hook nil
  100.   "Hook to run after each mouse event is processed.  Should take two
  101. arguments; the first being a list (XPOS YPOS) corresponding to character
  102. offset from top left of screen and the second being a specifier for the
  103. buttons/keys.
  104.  
  105. This will normally be set on a per-buffer basis.")
  106.  
  107. (defun amiga-flush-mouse-queue () 
  108.   "Process all queued mouse events."
  109.   ;; A mouse event causes a special character sequence to be given
  110.   ;; as keyboard input.  That runs this function, which process all
  111.   ;; queued mouse events and returns.
  112.   (interactive)
  113.   (while (> (amiga-mouse-events) 0)
  114.     (amiga-proc-mouse-event)
  115.     (and (boundp 'amiga-process-mouse-hook)
  116.      (symbol-value 'amiga-process-mouse-hook)
  117.      (funcall amiga-process-mouse-hook amiga-mouse-pos amiga-mouse-item))))
  118.  
  119. (defun amiga-mouse-select (arg)
  120.   "Select Emacs window the mouse is on."
  121.   (let ((start-w (selected-window))
  122.     (done nil)
  123.     (w (selected-window))
  124.     (rel-coordinate nil))
  125.     (if (eq start-w (minibuffer-window))
  126.     (setq rel-coordinate (coordinates-in-window-p arg w))
  127.     (while (and (not done)
  128.             (null (setq rel-coordinate
  129.                 (coordinates-in-window-p arg w))))
  130.       (setq w (next-window w))
  131.       (if (eq w start-w)
  132.           (setq done t))))
  133.     (select-window w)
  134.     rel-coordinate))
  135.  
  136. (defun amiga-mouse-keep-one-window (arg)
  137.   "Select Emacs window mouse is on, then kill all other Emacs windows."
  138.   (if (amiga-mouse-select arg)
  139.       (delete-other-windows)))
  140.  
  141. (defun amiga-mouse-select-and-split (arg)
  142.   "Select Emacs window mouse is on, then split it vertically in half."
  143.   (if (amiga-mouse-select arg)
  144.       (split-window-vertically nil)))
  145.  
  146.  
  147. (defun amiga-mouse-set-point (arg)
  148.   "Select Emacs window mouse is on, and move point to mouse position."
  149.   (let* ((relative-coordinate (amiga-mouse-select arg))
  150.      margin-column
  151.      (rel-x (car relative-coordinate))
  152.      (rel-y (car (cdr relative-coordinate))))
  153.     (if relative-coordinate
  154.     (let ((prompt-width (if (eq (selected-window) (minibuffer-window))
  155.                 minibuffer-prompt-width 0)))
  156.       (move-to-window-line rel-y)
  157.       (setq margin-column
  158.         (if (or truncate-lines (> (window-hscroll) 0))
  159.             (current-column)
  160.           ;; If we are using line continuation,
  161.           ;; compensate if first character on a continuation line
  162.           ;; does not start precisely at the margin.
  163.           (- (current-column)
  164.              (% (current-column) (1- (window-width))))))
  165.       (move-to-column (+ rel-x (1- (max 1 (window-hscroll)))
  166.                  (if (= (point) 1)
  167.                  (- prompt-width) 0)
  168.                  margin-column))))))
  169.  
  170. (defun amiga-mouse-set-mark (arg)
  171.   "Select Emacs window mouse is on, and set mark at mouse position.
  172. Display cursor at that position for a second."
  173.   (if (amiga-mouse-select arg)
  174.       (let ((point-save (point)))
  175.     (unwind-protect
  176.         (progn (amiga-mouse-set-point arg)
  177.            (push-mark nil t)
  178.            (sit-for 1))
  179.       (goto-char point-save)))))
  180.  
  181. (defun amiga-mouse-cut (arg)
  182.   "Select Emacs window mouse is on, and set mark at mouse position. 
  183. Display cursor at that position for a second. Then cut."
  184.   (if (amiga-mouse-select arg)
  185.       (let ((point-save (point)))
  186.     (unwind-protect
  187.         (progn (amiga-mouse-set-point arg)
  188.            (push-mark nil t)
  189.            (kill-region point-save (point))
  190.            (sit-for 1))
  191.       (goto-char point-save)))))
  192.  
  193. (defun amiga-mouse-copy (arg)
  194.   "Select Emacs window mouse is on, and set mark at mouse position. 
  195. Display cursor at that position for a second. Then copy."
  196.   (if (amiga-mouse-select arg)
  197.       (let ((point-save (point)))
  198.     (unwind-protect
  199.         (progn (amiga-mouse-set-point arg)
  200.            (push-mark nil t)
  201.            (copy-region-as-kill point-save (point))
  202.            (sit-for 1))
  203.       (goto-char point-save)))))
  204.  
  205. (defun amiga-mouse-paste (arg)
  206.   "Move point to mouse position (and select window), then paste."
  207.   (if (amiga-mouse-select arg)
  208.       (progn
  209.     (amiga-mouse-set-point arg)
  210.     (yank))))
  211.  
  212. (defun amiga-mouse-iconify (arg) (amiga-iconify))
  213.  
  214. (defun amiga-mouse-ignore (arg)
  215.   "Don't do anything.")
  216.  
  217. ; Prevent beeps. on button-up.  If the button isn't bound to anything, it
  218. (define-key mouse-map amiga-button-right 'amiga-mouse-ignore)
  219. (define-key mouse-map amiga-button-middle 'amiga-mouse-ignore)
  220. (define-key mouse-map amiga-bu