home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / terms / tek4404-mouse.el < prev    next >
Encoding:
Text File  |  1991-03-30  |  2.5 KB  |  73 lines
  1. ; Path: utkcs2!emory!swrinde!zaphod.mps.ohio-state.edu!tut.cis.ohio-state.edu!ELF.TN.CORNELL.EDU!eirik
  2. ; >From: eirik@ELF.TN.CORNELL.EDU ("Eirik Fuller")
  3. ; Newsgroups: gnu.emacs
  4. ; Subject: Tek 4404 mouse support
  5. ; Date: 24 Jul 90 03:09:11 GMT
  6. ; Organization: GNUs Not Usenet
  7. ; 
  8. ; The enclosed lisp code provides the machine-specific details necessary
  9. ; to use the mouse support in my previous posting with the terminal
  10. ; emulator of a Tektronix 4404 (and its various descendants like the
  11. ; 4315, 4316, and 4317).  On my system it is installed as
  12. ; /usr/local/emacs/lisp/term/4404.el; also included is a support
  13. ; function it uses.
  14. ; 
  15. ; ---------------- term/4404.el ----------------
  16. ; 
  17. (require 'add-hook)
  18. (require 'mouse)
  19.  
  20. (global-set-key "\M-P" 'tek4404-handle-mouse-event)
  21.  
  22. (defun tek4404-enable-mouse ()
  23.   "Send escape sequence which enables mouse events and graphics cursor"
  24.   (send-string-to-terminal "\C-[Q3;1J\C-[Q1M"))
  25.  
  26. (defun tek4404-disable-mouse ()
  27.   "Send escape sequence which disables mouse events and graphics cursor"
  28.   (send-string-to-terminal "\C-[QJ\C-[QM"))
  29.  
  30. (defun tek4404-handle-mouse-event ()
  31.   "Parse the escape sequence, and call the appropriate function"
  32.   (interactive)
  33.   (let ((state (read-char)) (button (read-char)) (way (read-char))
  34.     point index)
  35.     (setq point (- (read-number) 1))
  36.     (setq point (list (- (read-number) 1) point))
  37.     (setq index (+ (- ?3 button) (* (/ (- way ?D) 17) 4)))
  38.     (if (= (read-char) ?\\ )
  39.     (funcall (aref mouse-map index) point))))
  40.  
  41. (defun read-number ()
  42.   "Read digits from input and keep tally. Lose last character"
  43.   (let ((total 0) digit)
  44.     (while (progn 
  45.          (setq digit (read-char))
  46.          (and (>= digit ?0) (<= digit ?9)))
  47.       (setq total (+ (* total 10) (- digit ?0))))
  48.     total))
  49.  
  50. (add-hook 'kill-emacs-hook 'tek4404-disable-mouse)
  51. (add-hook 'suspend-hook 'tek4404-disable-mouse)
  52. (add-hook 'suspend-resume-hook 'tek4404-enable-mouse)
  53. (tek4404-enable-mouse)
  54.  
  55. ;; ---------------- add-hook.el ----------------
  56.  
  57. (provide 'add-hook)
  58.  
  59. (defun add-hook (hook-var hook-function)
  60.   "Prepend hook-function to hook-var's value, if it is not already an element.
  61. hook-var's value may be a single function or a list of functions."
  62.   (if (boundp hook-var)
  63.       (let ((value (symbol-value hook-var)))
  64.     (if (and (listp value) (not (eq (car value) 'lambda)))
  65.         (and (not (memq hook-function value))
  66.          (set hook-var
  67.               (if value (cons hook-function value) hook-function)))
  68.       (and (not (eq hook-function value))
  69.            (set hook-var
  70.             (list hook-function value)))))
  71.     (set hook-var hook-function)
  72.     ))
  73.