cgit.sxemacs.org Git - packages/blob - xemacs-packages/ess/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 (defun ess-rdired ()
 158   "Run dired-like mode on R objects.
 159 This is the main function.  See documentation for `ess-rdired-mode' though
 160 for more information!"
 161   (interactive)
 162   (if (get-buffer ess-rdired-buffer)
 163       (progn
 164         (set-buffer ess-rdired-buffer)
 165         (setq buffer-read-only nil)))
 166
 167    (ess-execute ess-rdired-objects
 168                 nil
 169                 (substring ess-rdired-buffer 1 (- (length ess-rdired-buffer) 1))
 170                 )
 171
 172   (pop-to-buffer ess-rdired-buffer)
 173   ;; When definiting the function .rdired.objects(), a "+ " is printed
 174   ;; for every line of the function definition; these are deleted
 175   ;; here.
 176   (delete-char (* (1- (length (split-string ess-rdired-objects "\n"))) 2))
 177
 178   ;; todo: not sure how to make ess-rdired-sort-num buffer local?
 179   ;;(set (make-local-variable 'ess-rdired-sort-num) 2)
 180   ;;(make-variable-buffer-local 'ess-rdired-sort-num)
 181   (setq ess-rdired-sort-num 1)
 182   (ess-rdired-insert-set-properties (save-excursion
 183                                   (goto-char (point-min))
 184                                   (forward-line 1)
 185                                   (point))
 186                                 (point-max))
 187   (setq buffer-read-only t)
 188   (ess-rdired-mode)
 189   )
 190
 191 (defun ess-rdired-object ()
 192   "Return name of object on current line."
 193   (save-excursion
 194     (beginning-of-line)
 195     (forward-char 2)
 196     (if (looking-at " ")
 197         nil                             ;on first line
 198       ;;
 199       (let (beg end)
 200         (setq beg (point))
 201         (search-forward " ")            ;assume space follows object name.
 202         (buffer-substring-no-properties beg (1- (point)))))))
 203
 204 (defun ess-rdired-edit ()
 205   "Edit (fix) the object at point."
 206   (interactive)
 207   (let ((objname (ess-rdired-object)))
 208     (ess-command (concat "edit(" objname ")\n"))))
 209
 210 (defun ess-rdired-view ()
 211   "View the object at point."
 212   (interactive)
 213   (let ((objname (ess-rdired-object)))
 214     (ess-execute objname nil "R view" )))
 215
 216 (defun ess-rdired-View ()
 217   "View the object at point in its own buffer.
 218 Like `ess-rdired-view', but the object gets its own buffer name."
 219   (interactive)
 220   (let ((objname (ess-rdired-object)))
 221     (ess-execute ;;(concat "edit(" objname ")\n")
 222      objname
 223      nil (concat "R view " objname ))))
 224
 225 (defun ess-rdired-plot ()
 226   "Plot the object on current line."
 227   (interactive)
 228   (let ((objname (ess-rdired-object)))
 229     (ess-command (concat "plot(" objname ")\n"))))
 230
 231 (defun ess-rdired-type ()
 232   "Run the mode() on command at point.
 233 Named type because of similarity
 234 with the dired command bound to y key."
 235   (interactive)
 236   (let ((objname (ess-rdired-object))
 237         ;; create a temp buffer, and then show output in echo area
 238         (tmpbuf (get-buffer-create "**ess-rdired-mode**")))
 239     (if objname
 240         (progn
 241           (ess-command (concat "mode(" objname ")\n")  tmpbuf )
 242           (set-buffer tmpbuf)
 243           (message (concat
 244                     objname ": "
 245                     (buffer-substring (+ 4 (point-min)) (1- (point-max)))))
 246           (kill-buffer tmpbuf)))))
 247
 248 (defun ess-rdired-delete (arg)
 249   "Mark the current (or next ARG) objects for deletion.
 250 If point is on first line, all objects are marked for deletion."
 251   (interactive "p")
 252   (ess-rdired-mark "D" arg))
 253
 254 (defun ess-rdired-undelete (arg)
 255   "Unmark the current (or next ARG) objects.
 256 If point is on first line, all objects will be unmarked."
 257   (interactive "p")
 258   (ess-rdired-mark " " arg))
 259
 260 (defun ess-rdired-mark (mark-char arg)
 261   "Mark the object, using MARK-CHAR,  on current line (or next ARG lines)."
 262   ;; If we are on first line, mark all lines.
 263   (let ((buffer-read-only nil)
 264         move)
 265     (if (eq (point-min)
 266             (save-excursion (beginning-of-line) (point)))
 267         (progn
 268           ;; we are on first line, so make a note of point, and count
 269           ;; how many objects we want to delete.  Then at end of defun,
 270           ;; restore point.
 271           (setq move (point))
 272           (forward-line 1)
 273           (setq arg (count-lines (point) (point-max)))))
 274     (while (and (> arg 0) (not (eobp)))
 275       (setq arg (1- arg))
 276       (beginning-of-line)
 277       (progn
 278         (insert mark-char)
 279         (delete-char 1)
 280         (forward-line 1)))
 281     (if move
 282         (goto-char move))))
 283
 284
 285 (defun ess-rdired-expunge ()
 286   "Delete the marked objects.
 287 User is queried first to check that objects should really be deleted."
 288   (interactive)
 289   (let ((objs "rm(")
 290         (count 0))
 291     (save-excursion
 292       (goto-line 2)
 293       (while (< (count-lines (point-min) (point))
 294                 (count-lines (point-min) (point-max)))
 295         (beginning-of-line)
 296         (if (looking-at "^D ")
 297             (setq count (1+ count)
 298                   objs (concat objs (ess-rdired-object) ", " )))
 299         (forward-line 1)
 300         ))
 301     (if (> count 0)
 302         ;; found objects to delete
 303         (progn
 304           (setq objs (concat
 305                       (substring objs 0 (- (length objs) 2))
 306                       ")\n"))
 307           (if (yes-or-no-p (format "Delete %d %s " count
 308                                    (if (> count 1) "objects" "object")))
 309               (progn
 310                 (ess-command objs)
 311                 (ess-rdired)
 312                 )))
 313       ;; else nothing to delete
 314       (message "no objects set to delete")
 315       )))
 316
 317 ;; Fancy delete method, based on dired.  Bit too much for our needs?
 318 ;; (defun ess-rdired-expunge ()
 319 ;;   "Delete the marked objects.
 320 ;; User is queried first to check that objects should really be deleted."
 321 ;;   (interactive)
 322 ;;   (let ((objs)
 323 ;;      (cmd "rm("))
 324 ;;     (save-excursion
 325 ;;       (goto-line 2)
 326 ;;       (while (< (count-lines (point-min) (point))
 327 ;;              (count-lines (point-min) (point-max)))
 328 ;;      (beginning-of-line)
 329 ;;      (if (looking-at "^D ")
 330 ;;          (progn
 331 ;;            (setq objs (cons (ess-rdired-object) objs ))
 332 ;;            (setq cmd (concat cmd (ess-rdired-object) ", "))
 333 ;;            ))
 334 ;;      (forward-line 1)
 335 ;;      ))
 336 ;;     (if (> (length objs) 0)
 337 ;;      ;; found objects to delete
 338 ;;      (if
 339 ;;          (dired-mark-pop-up "*RDired deletions*" 'delete
 340 ;;                             objs dired-deletion-confirmer
 341 ;;                             (format "delete %s "
 342 ;;                                     (dired-mark-prompt nil objs)))
 343 ;;          ;; should delete the objects.
 344 ;;          (progn
 345 ;;            (setq cmd (concat (substring cmd 0 (- (length cmd) 2))
 346 ;;                              ")\n"))
 347 ;;            (ess-command cmd)
 348 ;;            (ess-rdired)))
 349 ;;       ;; else nothing to delete
 350 ;;       (message "no objects set to delete")
 351 ;;       )))
 352
 353 (defun ess-rdired-quit ()
 354   "Quit the R dired buffer."
 355   (interactive)
 356   (kill-buffer ess-rdired-buffer))
 357
 358 (defun ess-rdired-revert-buffer (ignore noconfirm)
 359   "Update the buffer list (in case object list has changed).
 360 Arguments IGNORE and NOCONFIRM currently not used."
 361   (ess-rdired))
 362
 363 (defun ess-rdired-help ()
 364   "Show help for `ess-rdired-mode'."
 365   (interactive)
 366   (describe-function 'ess-rdired-mode))
 367
 368 (defun ess-rdired-sort ()
 369   "Sort the rdired output according to one of the columns.
 370 Rotate between the alternative sorting methods."
 371   (interactive)
 372   (setq ess-rdired-sort-num (1+ ess-rdired-sort-num))
 373   (let ((buffer-read-only nil)
 374         (beg (save-excursion
 375                (goto-char (point-min))
 376                (forward-line 1)
 377                (point)))
 378         (end (point-max)))
 379   (if (> ess-rdired-sort-num 3)
 380       (setq ess-rdired-sort-num 1))
 381   (cond ((eq ess-rdired-sort-num 1)
 382          (sort-fields 1 beg end))
 383         ((eq ess-rdired-sort-num 2)
 384          (sort-fields 2 beg end))
 385         ((eq ess-rdired-sort-num 3)
 386          (sort-numeric-fields 3 beg end)))))
 387
 388 (defun ess-rdired-next-line (arg)
 389   "Move down lines then position at object.
 390 Optional prefix ARG says how many lines to move; default is one line."
 391   (interactive "p")
 392   (next-line arg)
 393   (ess-rdired-move-to-object))
 394
 395 (defun ess-rdired-previous-line (arg)
 396   "Move up lines then position at object.
 397 Optional prefix ARG says how many lines to move; default is one line."
 398   (interactive "p")
 399   (previous-line arg)
 400   (ess-rdired-move-to-object))
 401
 402 (defun ess-rdired-move-to-object ()
 403   "Put point at start of object."
 404   (beginning-of-line)
 405   (forward-char 2)
 406   )
 407
 408 (defun ess-rdired-mouse-view (event)
 409   "In rdired, visit the object on the line you click on."
 410   (interactive "e")
 411   (let (window pos)
 412     (save-excursion
 413       (if (featurep 'xemacs)
 414           ;; XEmacs
 415           (setq window (event-window event)
 416                 pos (event-point event))
 417         ;; Emacs
 418         (setq window (posn-window (event-end event))
 419               pos (posn-point (event-end event))))
 420       (if (not (windowp window))
 421           (error "No file chosen"))
 422       (set-buffer (window-buffer window))
 423       (goto-char pos)
 424       (ess-rdired-view))))
 425
 426 (defun ess-rdired-insert-set-properties (beg end)
 427   "Add mouse highlighting to each object name in the R dired buffer."
 428   (save-excursion
 429     (goto-char beg)
 430     (while (< (point) end)
 431       (ess-rdired-move-to-object)
 432       (add-text-properties
 433        (point)
 434        (save-excursion
 435          (search-forward " ")
 436          (1- (point)))
 437        '(mouse-face highlight
 438                     help-echo "mouse-2: view object in other window"))
 439       (forward-line 1))))
 440
 441 (defun ess-rdired-switch-process ()
 442   "Switch to examine different *R* process.
 443 If you have multiple R processes running, e.g. *R*, *R:2*, *R:3*, you can
 444 use this command to choose which R process you would like to examine.
 445 After switching to a new process, the buffer is updated."
 446   (interactive)
 447   (ess-switch-process)
 448   (ess-rdired))
 449
 450 ;;; ess-rdired.el ends here.