cgit.sxemacs.org Git - sxemacs/blob - lisp/gpm.el

   1 ;;; gpm.el --- Support the mouse when emacs run on a Linux console.
   2
   3 ;; Copyright (C) 1999 Free Software Foundation
   4
   5 ;; Author: William Perry <wmperry@gnu.org>
   6 ;; Keywords: mouse, terminals
   7
   8 ;; This file is part of SXEmacs.
   9
  10 ;; SXEmacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; SXEmacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  22 (eval-when-compile
  23   (globally-declare-fboundp 'gpm-enable))
  24
  25
  26 (defvar gpm-enabled-devices (make-hash-table :test 'eq
  27                                              :size 13
  28                                              :weakness 'key)
  29   "A hash table of devices with GPM currently turned on.")
  30
  31 (defun gpm-mode (&optional arg device)
  32   "Toggle GPM mouse mode.
  33 With prefix arg, turn GPM mouse mode on if and only if arg is positive."
  34   (interactive (list current-prefix-arg (selected-device)))
  35   (cond
  36    ((null arg)                          ; Toggle
  37     (if (gethash device gpm-enabled-devices)
  38         (progn
  39           (gpm-enable device nil)
  40           (remhash device gpm-enabled-devices))
  41       (gpm-enable device t)
  42       (puthash device t gpm-enabled-devices)))
  43    ((> arg 0)                           ; Turn on
  44     (gpm-enable device t)
  45     (puthash device t gpm-enabled-devices))
  46    ((gethash device gpm-enabled-devices) ; Turn off
  47     (gpm-enable device nil)
  48     (remhash device gpm-enabled-devices))))
  49
  50 (defun turn-on-gpm-mouse-tracking (&optional device)
  51   ;; Enable mouse tracking on linux console
  52   (gpm-mode 5 device))
  53
  54 (defun turn-off-gpm-mouse-tracking (&optional device)
  55   ;; Disable mouse tracking on linux console
  56   (gpm-mode -5 device))
  57
  58 (defun gpm-create-device-hook (device)
  59   (if (and (not noninteractive)         ; Don't want to do this in batch mode
  60            (fboundp 'gpm-enable)        ; Must have C-level GPM support
  61            (eq system-type 'linux)      ; Must be running linux
  62            (eq (device-type device) 'tty) ; on a tty
  63            (equal "linux" (console-tty-terminal-type ; an a linux terminal type
  64                            (device-console device))))
  65       (turn-on-gpm-mouse-tracking device)))
  66
  67 (defun gpm-delete-device-hook (device)
  68   (if (and (not noninteractive)         ; Don't want to do this in batch mode
  69            (fboundp 'gpm-enable)        ; Must have C-level GPM support
  70            (eq system-type 'linux)      ; Must be running linux
  71            (eq (device-type device) 'tty) ; on a tty
  72            (equal "linux" (console-tty-terminal-type ; an a linux terminal type
  73                            (device-console device))))
  74       (turn-off-gpm-mouse-tracking device)))
  75
  76 ;; Restore normal mouse behavior outside Emacs
  77
  78 (add-hook 'suspend-hook 'turn-off-gpm-mouse-tracking)
  79 (add-hook 'suspend-resume-hook 'turn-on-gpm-mouse-tracking)
  80 (add-hook 'create-device-hook 'gpm-create-device-hook)
  81 (add-hook 'delete-device-hook 'gpm-delete-device-hook)
  82
  83 (provide 'gpm)