lisp/ess-mous.el

   1 ;;; ess-mous.el --- Support for mouse- or cursor-sensitive actions
   2
   3 ;; Copyright (C) 2001 Richard M. Heiberger <rmh@sbm.temple.edu>
   4 ;; Copyright (C) 2002--2004 A.J. Rossini, Rich M. Heiberger, Martin
   5 ;;      Maechler, Kurt Hornik, Rodney Sparapani, and Stephen Eglen.
   6
   7 ;; Original Author: Richard M. Heiberger <rmh@sbm.temple.edu>
   8 ;; Created: 25 Mar 2001
   9 ;; Maintainers: ESS-core <ESS-core@stat.math.ethz.ch>
  10
  11 ;; This file is part of ESS
  12
  13 ;; This file is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17
  18 ;; This file is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  25 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  26
  27 ;;; Commentary:
  28
  29 ;; Support for mouse- or cursor-sensitive actions.  This is based on
  30 ;; and uses mouseme.el.  mouseme.el only does mouse sensititivity.
  31 ;; The new functions ess-mouse-me and ess-mouse-me-helper do similar
  32 ;; things based on the cursor, not the mouse, and can be bound to a
  33 ;; keystroke.
  34
  35 ;;; Code:
  36
  37 \f ; Requires and autoloads
  38
  39 ;;*;; Requires
  40 (require 'mouseme)
  41 ;;(if (or (equal window-system 'w32)
  42 ;;      (equal window-system 'win32)
  43 ;;      (equal window-system 'mswindows))
  44 ;;    (require 'essiw32b))
  45
  46 (defun ess-mouse-me ()
  47   "Popup a menu of functions to run on selected string or region."
  48   (interactive)
  49   (ess-mouse-me-helper
  50    #'(lambda ()
  51        (or (x-popup-menu (list '(0 0)
  52                                (get-buffer-window (get-buffer (buffer-name))))
  53                          (funcall mouse-me-build-menu-function name))
  54            (error "No command to run")))))
  55
  56
  57
  58 (defun ess-mouse-me-helper (func)
  59   "Determine the string to use to process EVENT and call FUNC to get cmd."
  60   (let (name sp sm mouse beg end cmd mmtype)
  61     ;; temporarily goto where the event occurred, get the name clicked
  62     ;; on and enough info to figure out what to do with it
  63     (save-match-data
  64       (save-excursion
  65         (setq sp (point))               ; saved point
  66         (setq sm (mark t))              ; saved mark
  67 ;;;     (set-buffer (window-buffer (posn-window (event-start event))))
  68 ;;;     (setq mouse (goto-char (posn-point (event-start event))))
  69         (setq mouse (point))  ;; ess-mouse-me-helper
  70         ;; if there is a region and point is inside it
  71         ;; check for sm first incase (null (mark t))
  72         ;; set name to either the thing they clicked on or region
  73         (if (and sm
  74                  (or (and transient-mark-mode mark-active)
  75                      (eq last-command 'mouse-drag-region))
  76                  (>= mouse (setq beg (min sp sm)))
  77                  (<= mouse (setq end (max sp sm))))
  78             (setq name (buffer-substring beg end))
  79           (setq name (funcall mouse-me-get-string-function))
  80           (if (listp name)
  81               (setq beg (nth 1 name)
  82                     end (nth 2 name)
  83                     name (car name))
  84             (goto-char mouse)
  85             (while (not (looking-at (regexp-quote name)))
  86               (backward-char 1))
  87             (setq beg (point))
  88             (setq end (search-forward name))))))
  89     ;; check if name is null, meaning they clicked on no word
  90     (if (or (null name)
  91             (and (stringp name) (string= name "" )))
  92         (error "No string to pass to function"))
  93     ;; popup a menu to get a command to run
  94     (setq cmd (funcall func))
  95     ;; run the command, eval'ing if it was a list
  96     (if (listp cmd)
  97         (setq cmd (eval cmd)))
  98     (setq mmtype (get cmd 'mouse-me-type))
  99     (cond ((eq mmtype 'region)
 100            (funcall cmd beg end))
 101           ((eq mmtype 'string)
 102            (funcall cmd name))
 103           (t
 104            (funcall cmd name)))))
 105
 106 (defcustom ess-S-mouse-me-menu-commands-alist
 107   '("S-Plus 4 and 6 GUI under Windows"
 108     ("Edit.data"   . ess-mouse-me-Edit.data)
 109     "----"
 110     ("print"       . ess-mouse-me-print)
 111     ("summary"     . ess-mouse-me-summary)
 112     ("plot"        . ess-mouse-me-plot)
 113     ("show"        . ess-mouse-me-show)
 114     ("help"        . ess-display-help-on-object)
 115     ("args"        . ess-mouse-me-args)
 116     "----"
 117     ("Browser on"  . ess-mouse-me-browser-on)
 118     ("Browser off" . ess-mouse-me-browser-off))
 119     "*Command menu used by `mouse-me-build-menu'.
 120 A alist of elements where each element is either a cons cell or a string.
 121 If a cons cell the car is a string to be displayed in the menu and the
 122 cdr is either a function to call passing a string to, or a list which evals
 123 to a function to call passing a string to.  If the element is a string
 124 it makes a non-selectable element in the menu.  To make a separator line
 125 use a string consisting solely of hyphens.
 126
 127 The function returned from this menu will be called with one string
 128 argument.  Or if the function has the symbol property `mouse-me-type'
 129 and if its value is the symbol `region' it will be called with the
 130 beginning and ending points of the selected string.  If the value is
 131 the symbol `string' it will be called with one string argument."
 132   :type '(repeat sexp)
 133   :group 'mouseme)
 134
 135
 136 (defun ess-mouse-me-Edit.data (string)
 137   (ess-mouse-me-eval-expanded string "Edit.data(" ")" nil nil nil))
 138
 139 (defun ess-mouse-me-print (string)
 140   (ess-mouse-me-eval-expanded string "" "" nil (ess-ddeclient-p) t))
 141 (defun ess-mouse-me-summary (string)
 142   (ess-mouse-me-eval-expanded string "summary(" ")" nil (ess-ddeclient-p) t))
 143 (defun ess-mouse-me-plot (string)
 144   (ess-mouse-me-eval-expanded string "plot(" ")") nil nil nil)
 145 (defun ess-mouse-me-show (string)
 146   (ess-mouse-me-eval-expanded string "show(" ")") nil nil nil)
 147 (defun ess-mouse-me-args (string)
 148   (ess-mouse-me-eval-expanded string "args(" ")" nil (ess-ddeclient-p) t))
 149
 150 (defun ess-mouse-me-browser-on (string)
 151   (if (equal (substring ess-dialect 0 1) "R")
 152        (ess-eval-linewise (concat "debug(" string ")"))
 153    (ess-mouse-me-eval-expanded string "trace(" ", exit=browser)") nil nil nil))
 154
 155 (defun ess-mouse-me-browser-off  (string)
 156   (if (equal (substring ess-dialect 0 1) "R")
 157        (ess-eval-linewise (concat "undebug(" string ")"))
 158    (ess-mouse-me-eval-expanded string "untrace(" ")") nil nil nil))
 159
 160
 161
 162 (defun ess-mouse-me-eval-expanded (string &optional head tail commands-buffer
 163                                           page value-returned)
 164   "Send the expanded STRING to the inferior-ess process using `ess-command'
 165 after first concating the HEAD and TAIL.  Put answer in COMMANDS-BUFFER if
 166 specified and not using ddeclient, otherwise in \"tmp-buffer\".  In either
 167 case the buffer containing the answer is renamed to the value of the
 168 constructed command.  If PAGE is non-nil and using ddeclient, expand
 169 the string one more time by embedding it in a \"page()\" command."
 170   (interactive)
 171   (let* (scommand
 172          page-scommand
 173          (ess-mouse-customize-alist ess-local-customize-alist))
 174     (if (not head) (setq head "summary("))
 175     (if (not tail) (setq tail ")"))
 176     (if (not commands-buffer) (setq commands-buffer
 177                                     (get-buffer-create "tmp-buffer")))
 178     (setq scommand (concat head string tail))
 179
 180     (if (ess-ddeclient-p)
 181         (progn
 182           (setq page-scommand (if page
 183                                   (concat "page(" scommand ")")
 184                                 scommand))
 185           (set-buffer-file-coding-system 'undecided-dos)
 186           (ess-command page-scommand commands-buffer)
 187           (if (not value-returned)
 188               nil
 189             (sleep-for 2)
 190             (switch-to-buffer (car (buffer-list)))))
 191       (ess-make-buffer-current)
 192       (switch-to-buffer commands-buffer)
 193       (ess-setq-vars-local (eval ess-mouse-customize-alist) (current-buffer))
 194       (setq ess-local-process-name ess-current-process-name)
 195       (ess-command (concat scommand "\n") commands-buffer)
 196       (if (not value-returned) (switch-to-buffer (nth 1 (buffer-list)))))
 197     (if (not value-returned)
 198         nil
 199       (if ess-microsoft-p                      ;; there ought to be a filter
 200           (while (search-forward "\r" nil t)   ;; function to keep the ^M
 201             (replace-match "" nil t)))         ;; from showing up at all
 202       (ess-transcript-mode (eval ess-mouse-customize-alist))
 203       (setq ess-local-process-name ess-current-process-name)
 204       (rename-buffer scommand))))
 205
 206
 207 \f ; Provide package
 208
 209 (provide 'ess-mous)
 210
 211
 212
 213 ;;;;;;;; STARTUP STUFF ;;;;;;;;;;;;
 214
 215 (make-variable-buffer-local 'mouse-me-menu-commands)
 216
 217 (defun ess-S-mouse-me-menu-commands ()
 218   (if (equal ess-language "S")
 219       (setq mouse-me-menu-commands ess-S-mouse-me-menu-commands-alist)))
 220
 221 ;; (if (not (featurep 'xemacs))
 222 ;;     (progn
 223 ;;       ;;gnu emacs
 224 ;;       (define-key ess-mode-map              [S-mouse-3] 'ess-mouse-me)
 225 ;;       (define-key inferior-ess-mode-map     [S-mouse-3] 'ess-mouse-me)
 226 ;;       (defun ess-S-mouse-me-ess-transcript-mode ()
 227 ;;      (define-key ess-transcript-mode-map [S-mouse-3] 'ess-mouse-me)))
 228 ;;   ;; xemacs
 229 ;;   (define-key ess-mode-map              [(shift button3)] 'ess-mouse-me)
 230 ;;   (define-key inferior-ess-mode-map     [(shift button3)] 'ess-mouse-me)
 231 ;;   (defun ess-S-mouse-me-ess-transcript-mode ()
 232 ;;     (define-key ess-transcript-mode-map [(shift button3)] 'ess-mouse-me)))
 233 ;;
 234 (add-hook 'ess-mode-hook            'ess-S-mouse-me-menu-commands)
 235 (add-hook 'inferior-ess-mode-hook   'ess-S-mouse-me-menu-commands)
 236 (add-hook 'ess-transcript-mode-hook 'ess-S-mouse-me-menu-commands)
 237 ;; (add-hook 'ess-transcript-mode-hook 'ess-S-mouse-me-ess-transcript-mode)
 238
 239
 240 \f ; Local variables section
 241
 242 ;;; This file is automatically placed in Outline minor mode.
 243 ;;; The file is structured as follows:
 244 ;;; Chapters:     ^L ;
 245 ;;; Sections:    ;;*;;
 246 ;;; Subsections: ;;;*;;;
 247 ;;; Components:  defuns, defvars, defconsts
 248 ;;;              Random code beginning with a ;;;;* comment
 249
 250 ;;; Local variables:
 251 ;;; mode: emacs-lisp
 252 ;;; outline-minor-mode: nil
 253 ;;; mode: outline-minor
 254 ;;; outline-regexp: "\^L\\|\\`;\\|;;\\*\\|;;;\\*\\|(def[cvu]\\|(setq\\|;;;;\\*"
 255 ;;; End:
 256
 257 ;;; ess-mous.el ends here