lisp/ess-rdired.el

   1 ;;; ess-rdired.el --- prototype object browser for R, looks like dired mode.
   2
   3 ;; Copyright (C) 2002--2004 A.J. Rossini, Rich M. Heiberger, Martin
   4 ;;      Maechler, Kurt Hornik, Rodney Sparapani, and Stephen Eglen.
   5
   6 ;; Original Author: Stephen Eglen <stephen@anc.ed.ac.uk>
   7 ;; Created: Thu 24 Oct 2002
   8 ;; Maintainers: ESS-core <ESS-core@stat.math.ethz.ch>
   9
  10 ;; This file is part of ESS
  11
  12 ;; This file is not part of GNU Emacs.
  13
  14 ;; ess-rdired.el is free software; you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation; either version 2, or (at your option)
  17 ;; any later version.
  18
  19 ;; ess-rdired.el is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  27 ;; Boston, MA 02111-1307, USA.
  28
  29 ;; This provides a dired-like buffer for R objects.  Instead of
  30 ;; operating on files, we operate on R objects in the current
  31 ;; environment.  Objects can be viewed, edited, deleted, plotted and
  32 ;; so on.
  33
  34 ;; Installation and usage.
  35 ;;
  36 ;; Load in this library, e.g. with the command:
  37 ;; (autoload 'ess-rdired "ess-rdired" "View *R* objects in a dired-like buffer." t)
  38 ;;
  39 ;; After loading this file, do "M-x R" to start an R session, then
  40 ;; create a few variables:
  41 ;; s <- sin(seq(from=0, to=8*pi, length=100))
  42 ;; x <- c(1, 4, 9)
  43 ;; y <- rnorm(20)
  44 ;; z <- TRUE
  45
  46 ;; Then in Emacs, do "M-x ess-rdired" and you should see the following in
  47 ;; the buffer *R dired*:
  48 ;;        mode length
  49 ;;   s numeric    100
  50 ;;   x numeric      3
  51 ;;   y numeric     20
  52 ;;   z logical      1
  53
  54 ;; Type "?" in the buffer to see the documentation.  e.g. when the
  55 ;; cursor is on the line for `s', type 'p' to plot it, or `v' to view
  56 ;; its contents in a buffer.  Then type 'd' to mark it for deletion.
  57
  58 ;; How it works.
  59
  60 ;; Most of the hardwork is done by the R routine .rdired.objects(),
  61 ;; which, when called, produces the list of objects in a tidy format.
  62 ;; This function is stored within the lisp variable `ess-rdired-objects',
  63 ;; and can be altered to provide other information if you so need it.
  64 ;; (Martin Maechler suggested providing output from str() here.)
  65
  66 ;; Tested on Emacs 21.2, 21.3 pretest and XEmacs 21.1.14, using R 1.6.
  67
  68 ;; Todo - compare functionality with ess-mouse-me (ess-mous.el).
  69
  70 ;; Todo - How to select alternative environments?  Currently only
  71 ;; shows objects in the .GlobalEnv?  See BrowseEnv() in 1.6.x for way
  72 ;; of browsing other environments.
  73
  74 ;; Todo - problem with fix -- have to wait for fix() command to return
  75 ;; before *R* buffer can be used again.  This can get stuck, umm. not
  76 ;; sure what is going wrong here.  Maybe add a hook to the temp buffer
  77 ;; so that when buffer is killed, we send an instruction to R to
  78 ;; update the value of the variable to the contents of the buffer.
  79 ;; This way *R* doesn't have to wait.
  80
  81 ;; Todo - small bug in .rdired.objects -- if we have a variable called
  82 ;; `my.x', its value is replaced by the value of my.x used in the
  83 ;; sapply() calls within .rdired.objects().
  84
  85
  86 (defvar ess-rdired-objects ".rdired.objects <- function(objs) {
  87   if (length(objs)==0)
  88     \"No objects to view!\"
  89   else {
  90   mode <- sapply(objs, function(my.x) {
  91     eval(parse(text=(paste('data.class(',my.x,')',sep=''))))})
  92   length <- sapply(objs, function(my.x) {
  93     eval(parse(text=(paste('length(',my.x,')',sep=''))))
  94   })
  95   d <- data.frame(mode, length)
  96   row.names(d) <- paste('  ', row.names(d), sep='')
  97   d
  98   }
  99 }; .rdired.objects(ls())"
 100   "Function to call within R to print information on objects.  The last
 101 line of this string should be the instruction to call the
 102 function which prints the output for rdired.")
 103
 104 (defvar ess-rdired-buffer "*R dired*"
 105   "Name of buffer for displaying R objects.")
 106
 107 (defvar ess-rdired-mode-map nil
 108   "Keymap for the *R dired* buffer.")
 109
 110 (if ess-rdired-mode-map
 111     ()
 112   (setq ess-rdired-mode-map (make-sparse-keymap))
 113
 114   (define-key ess-rdired-mode-map "?" 'ess-rdired-help)
 115   (define-key ess-rdired-mode-map "d" 'ess-rdired-delete)
 116   (define-key ess-rdired-mode-map "u" 'ess-rdired-undelete)
 117   (define-key ess-rdired-mode-map "x" 'ess-rdired-expunge)
 118   ;; editing requires a little more work.
 119   ;;(define-key ess-rdired-mode-map "e" 'ess-rdired-edit)
 120   (define-key ess-rdired-mode-map "v" 'ess-rdired-view)
 121   (define-key ess-rdired-mode-map "V" 'ess-rdired-View)
 122   (define-key ess-rdired-mode-map "p" 'ess-rdired-plot)
 123   (define-key ess-rdired-mode-map "s" 'ess-rdired-sort)
 124   (define-key ess-rdired-mode-map "q" 'ess-rdired-quit)
 125   (define-key ess-rdired-mode-map "y" 'ess-rdired-type) ;what type?
 126   (define-key ess-rdired-mode-map " "  'ess-rdired-next-line)
 127   (define-key ess-rdired-mode-map [backspace] 'ess-rdired-previous-line)
 128   (define-key ess-rdired-mode-map "\C-n" 'ess-rdired-next-line)
 129   (define-key ess-rdired-mode-map "\C-p" 'ess-rdired-previous-line)
 130
 131   ;; R mode keybindings.
 132   (define-key ess-rdired-mode-map "\C-c\C-s" 'ess-rdired-switch-process)
 133   (define-key ess-rdired-mode-map "\C-c\C-y" 'ess-switch-to-ESS)
 134   (define-key ess-rdired-mode-map "\C-c\C-z" 'ess-switch-to-end-of-ESS)
 135
 136   (define-key ess-rdired-mode-map [down] 'ess-rdired-next-line)
 137   (define-key ess-rdired-mode-map [up] 'ess-rdired-previous-line)
 138   (define-key ess-rdired-mode-map "g" 'revert-buffer)
 139   (if (featurep 'xemacs)
 140       (define-key ess-rdired-mode-map [button2] 'ess-rdired-mouse-view)
 141     (define-key ess-rdired-mode-map [mouse-2] 'ess-rdired-mouse-view)
 142     ))
 143
 144 (defun ess-rdired-mode ()
 145   "Major mode for output from `ess-rdired'.
 146 `ess-rdired' provides a dired-like mode for R objects.  It shows the
 147 list of current objects in the current environment, one-per-line.  You
 148 can then examine these objects, plot them, and so on.
 149 \\{ess-rdired-mode-map}"
 150   (kill-all-local-variables)
 151   (make-local-variable 'revert-buffer-function)
 152   (setq revert-buffer-function 'ess-rdired-revert-buffer)
 153   (use-local-map ess-rdired-mode-map)
 154   (setq major-mode 'ess-rdired-mode)
 155   (setq mode-name (concat "RDired " ess-local-process-name)))
 156
 157 (defvar ess-rdired-sort-num nil)        ;silence the compiler.
 158 ;; but see following defun -- maybe it should be buffer local.
 159
 160 (defun ess-rdired ()
 161   "Run dired-like mode on R objects.
 162 This is the main function.  See documentation for `ess-rdired-mode' though
 163 for more information!"
 164   (interactive)
 165   (if (get-buffer ess-rdired-buffer)
 166       (progn
 167         (set-buffer ess-rdired-buffer)
 168         (setq buffer-read-only nil)))
 169
 170    (ess-execute ess-rdired-objects
 171                 nil
 172                 (substring ess-rdired-buffer 1 (- (length ess-rdired-buffer) 1))
 173                 )
 174
 175   (pop-to-buffer ess-rdired-buffer)
 176   ;; When definiting the function .rdired.objects(), a "+ " is printed
 177   ;; for every line of the function definition; these are deleted
 178   ;; here.
 179   (delete-char (* (1- (length (split-string ess-rdired-objects "\n"))) 2))
 180
 181   ;; todo: not sure how to make ess-rdired-sort-num buffer local?
 182   ;;(set (make-local-variable 'ess-rdired-sort-num) 2)
 183   ;;(make-variable-buffer-local 'ess-rdired-sort-num)
 184   (setq ess-rdired-sort-num 1)
 185   (ess-rdired-insert-set-properties (save-excursion
 186                                   (goto-char (point-min))
 187                                   (forward-line 1)
 188                                   (point))
 189                                 (point-max))
 190   (setq buffer-read-only t)
 191   (ess-rdired-mode)
 192   )
 193
 194 (defun ess-rdired-object ()
 195   "Return name of object on current line."
 196   (save-excursion
 197     (beginning-of-line)
 198     (forward-char 2)
 199     (if (looking-at " ")
 200         nil                             ;on first line
 201       ;;
 202       (let (beg end)
 203         (setq beg (point))
 204         (search-forward " ")            ;assume space follows object name.
 205         (buffer-substring-no-properties beg (1- (point)))))))
 206
 207 (defun ess-rdired-edit ()
 208   "Edit (fix) the object at point."
 209   (interactive)
 210   (let ((objname (ess-rdired-object)))
 211     (ess-command (concat "edit(" objname ")\n"))))
 212
 213 (defun ess-rdired-view ()
 214   "View the object at point."
 215   (interactive)
 216   (let ((objname (ess-rdired-object)))
 217     (ess-execute objname nil "R view" )))
 218
 219 (defun ess-rdired-View ()
 220   "View the object at point in its own buffer.
 221 Like `ess-rdired-view', but the object gets its own buffer name."
 222   (interactive)
 223   (let ((objname (ess-rdired-object)))
 224     (ess-execute ;;(concat "edit(" objname ")\n")
 225      objname
 226      nil (concat "R view " objname ))))
 227
 228 (defun ess-rdired-plot ()
 229   "Plot the object on current line."
 230   (interactive)
 231   (let ((objname (ess-rdired-object)))
 232     (ess-command (concat "plot(" objname ")\n"))))
 233
 234 (defun ess-rdired-type ()
 235   "Run the mode() on command at point.
 236 Named type because of similarity
 237 with the dired command bound to y key."
 238   (interactive)
 239   (let ((objname (ess-rdired-object))
 240         ;; create a temp buffer, and then show output in echo area
 241         (tmpbuf (get-buffer-create "**ess-rdired-mode**")))
 242     (if objname
 243         (progn
 244           (ess-command (concat "mode(" objname ")\n")  tmpbuf )
 245           (set-buffer tmpbuf)
 246           (message (concat
 247                     objname ": "
 248                     (buffer-substring (+ 4 (point-min)) (1- (point-max)))))
 249           (kill-buffer tmpbuf)))))
 250
 251 (defun ess-rdired-delete (arg)
 252   "Mark the current (or next ARG) objects for deletion.
 253 If point is on first line, all objects are marked for deletion."
 254   (interactive "p")
 255   (ess-rdired-mark "D" arg))
 256
 257 (defun ess-rdired-undelete (arg)
 258   "Unmark the current (or next ARG) objects.
 259 If point is on first line, all objects will be unmarked."
 260   (interactive "p")
 261   (ess-rdired-mark " " arg))
 262
 263 (defun ess-rdired-mark (mark-char arg)
 264   "Mark the object, using MARK-CHAR,  on current line (or next ARG lines)."
 265   ;; If we are on first line, mark all lines.
 266   (let ((buffer-read-only nil)
 267         move)
 268     (if (eq (point-min)
 269             (save-excursion (beginning-of-line) (point)))
 270         (progn
 271           ;; we are on first line, so make a note of point, and count
 272           ;; how many objects we want to delete.  Then at end of defun,
 273           ;; restore point.
 274           (setq move (point))
 275           (forward-line 1)
 276           (setq arg (count-lines (point) (point-max)))))
 277     (while (and (> arg 0) (not (eobp)))
 278       (setq arg (1- arg))
 279       (beginning-of-line)
 280       (progn
 281         (insert mark-char)
 282         (delete-char 1)
 283         (forward-line 1)))
 284     (if move
 285         (goto-char move))))
 286
 287
 288 (defun ess-rdired-expunge ()
 289   "Delete the marked objects.
 290 User is queried first to check that objects should really be deleted."
 291   (interactive)
 292   (let ((objs "rm(")
 293         (count 0))
 294     (save-excursion
 295       (goto-line 2)
 296       (while (< (count-lines (point-min) (point))
 297                 (count-lines (point-min) (point-max)))
 298         (beginning-of-line)
 299         (if (looking-at "^D ")
 300             (setq count (1+ count)
 301                   objs (concat objs (ess-rdired-object) ", " )))
 302         (forward-line 1)
 303         ))
 304     (if (> count 0)
 305         ;; found objects to delete
 306         (progn
 307           (setq objs (concat
 308                       (substring objs 0 (- (length objs) 2))
 309                       ")\n"))
 310           (if (yes-or-no-p (format "Delete %d %s " count
 311                                    (if (> count 1) "objects" "object")))
 312               (progn
 313                 (ess-command objs)
 314                 (ess-rdired)
 315                 )))
 316       ;; else nothing to delete
 317       (message "no objects set to delete")
 318       )))
 319
 320 ;; Fancy delete method, based on dired.  Bit too much for our needs?
 321 ;; (defun ess-rdired-expunge ()
 322 ;;   "Delete the marked objects.
 323 ;; User is queried first to check that objects should really be deleted."
 324 ;;   (interactive)
 325 ;;   (let ((objs)
 326 ;;      (cmd "rm("))
 327 ;;     (save-excursion
 328 ;;       (goto-line 2)
 329 ;;       (while (< (count-lines (point-min) (point))
 330 ;;              (count-lines (point-min) (point-max)))
 331 ;;      (beginning-of-line)
 332 ;;      (if (looking-at "^D ")
 333 ;;          (progn
 334 ;;            (setq objs (cons (ess-rdired-object) objs ))
 335 ;;            (setq cmd (concat cmd (ess-rdired-object) ", "))
 336 ;;            ))
 337 ;;      (forward-line 1)
 338 ;;      ))
 339 ;;     (if (> (length objs) 0)
 340 ;;      ;; found objects to delete
 341 ;;      (if
 342 ;;          (dired-mark-pop-up "*RDired deletions*" 'delete
 343 ;;                             objs dired-deletion-confirmer
 344 ;;                             (format "delete %s "
 345 ;;                                     (dired-mark-prompt nil objs)))
 346 ;;          ;; should delete the objects.
 347 ;;          (progn
 348 ;;            (setq cmd (concat (substring cmd 0 (- (length cmd) 2))
 349 ;;                              ")\n"))
 350 ;;            (ess-command cmd)
 351 ;;            (ess-rdired)))
 352 ;;       ;; else nothing to delete
 353 ;;       (message "no objects set to delete")
 354 ;;       )))
 355
 356 (defun ess-rdired-quit ()
 357   "Quit the R dired buffer."
 358   (interactive)
 359   (kill-buffer ess-rdired-buffer))
 360
 361 (defun ess-rdired-revert-buffer (ignore noconfirm)
 362   "Update the buffer list (in case object list has changed).
 363 Arguments IGNORE and NOCONFIRM currently not used."
 364   (ess-rdired))
 365
 366 (defun ess-rdired-help ()
 367   "Show help for `ess-rdired-mode'."
 368   (interactive)
 369   (describe-function 'ess-rdired-mode))
 370
 371 (defun ess-rdired-sort ()
 372   "Sort the rdired output according to one of the columns.
 373 Rotate between the alternative sorting methods."
 374   (interactive)
 375   (setq ess-rdired-sort-num (1+ ess-rdired-sort-num))
 376   (let ((buffer-read-only nil)
 377         (beg (save-excursion
 378                (goto-char (point-min))
 379                (forward-line 1)
 380                (point)))
 381         (end (point-max)))
 382   (if (> ess-rdired-sort-num 3)
 383       (setq ess-rdired-sort-num 1))
 384   (cond ((eq ess-rdired-sort-num 1)
 385          (sort-fields 1 beg end))
 386         ((eq ess-rdired-sort-num 2)
 387          (sort-fields 2 beg end))
 388         ((eq ess-rdired-sort-num 3)
 389          (sort-numeric-fields 3 beg end)))))
 390
 391 (defun ess-rdired-next-line (arg)
 392   "Move down lines then position at object.
 393 Optional prefix ARG says how many lines to move; default is one line."
 394   (interactive "p")
 395   (next-line arg)
 396   (ess-rdired-move-to-object))
 397
 398 (defun ess-rdired-previous-line (arg)
 399   "Move up lines then position at object.
 400 Optional prefix ARG says how many lines to move; default is one line."
 401   (interactive "p")
 402   (previous-line arg)
 403   (ess-rdired-move-to-object))
 404
 405 (defun ess-rdired-move-to-object ()
 406   "Put point at start of object."
 407   (beginning-of-line)
 408   (forward-char 2)
 409   )
 410
 411 (defun ess-rdired-mouse-view (event)
 412   "In rdired, visit the object on the line you click on."
 413   (interactive "e")
 414   (let (window pos)
 415     (save-excursion
 416       (if (featurep 'xemacs)
 417           ;; XEmacs
 418           (setq window (event-window event)
 419                 pos (event-point event))
 420         ;; Emacs
 421         (setq window (posn-window (event-end event))
 422               pos (posn-point (event-end event))))
 423       (if (not (windowp window))
 424           (error "No file chosen"))
 425       (set-buffer (window-buffer window))
 426       (goto-char pos)
 427       (ess-rdired-view))))
 428
 429 (defun ess-rdired-insert-set-properties (beg end)
 430   "Add mouse highlighting to each object name in the R dired buffer."
 431   (save-excursion
 432     (goto-char beg)
 433     (while (< (point) end)
 434       (ess-rdired-move-to-object)
 435       (add-text-properties
 436        (point)
 437        (save-excursion
 438          (search-forward " ")
 439          (1- (point)))
 440        '(mouse-face highlight
 441                     help-echo "mouse-2: view object in other window"))
 442       (forward-line 1))))
 443
 444 (defun ess-rdired-switch-process ()
 445   "Switch to examine different *R* process.
 446 If you have multiple R processes running, e.g. *R*, *R:2*, *R:3*, you can
 447 use this command to choose which R process you would like to examine.
 448 After switching to a new process, the buffer is updated."
 449   (interactive)
 450   (ess-switch-process)
 451   (ess-rdired))
 452
 453 ;;; ess-rdired.el ends here.