(defvar ess-rdired-objects "{.rdired.objects <- function(objs) {
if (length(objs)==0) {
\"No objects to view!\"
} else {
mode <- sapply(objs, function(my.x) {
eval( parse( text=sprintf('data.class(get(\"%s\"))', my.x))) })
length <- sapply(objs, function(my.x) {
eval( parse( text=sprintf('length(get(\"%s\"))', my.x))) })
d <- data.frame(mode, length)
var.names <- row.names(d)
## If any names contain spaces, we need to quote around them.
quotes = rep('', length(var.names))
spaces = grep(' ', var.names)
if (any(spaces))
quotes[spaces] <- '\"'
var.names = paste(quotes, var.names, quotes, sep='')
row.names(d) <- paste(' ', var.names, sep='')
d
}
}; cat('\n'); print(.rdired.objects(ls()))}\n"
"Function to call within R to print information on objects. The last
line of this string should be the instruction to call the
function which prints the output for rdired.")
(defvar ess-rdired-buffer "*R dired*"
"Name of buffer for displaying R objects.")
(defvar ess-rdired-mode-map
(let ((ess-rdired-mode-map (make-sparse-keymap)))
(define-key ess-rdired-mode-map "?" 'ess-rdired-help)
(define-key ess-rdired-mode-map "d" 'ess-rdired-delete)
(define-key ess-rdired-mode-map "u" 'ess-rdired-undelete)
(define-key ess-rdired-mode-map "x" 'ess-rdired-expunge)
(define-key ess-rdired-mode-map "v" 'ess-rdired-view)
(define-key ess-rdired-mode-map "V" 'ess-rdired-View)
(define-key ess-rdired-mode-map "p" 'ess-rdired-plot)
(define-key ess-rdired-mode-map "s" 'ess-rdired-sort)
(define-key ess-rdired-mode-map "q" 'ess-rdired-quit)
(define-key ess-rdired-mode-map "y" 'ess-rdired-type)
(define-key ess-rdired-mode-map " " 'ess-rdired-next-line)
(define-key ess-rdired-mode-map [backspace] 'ess-rdired-previous-line)
(define-key ess-rdired-mode-map "\C-n" 'ess-rdired-next-line)
(define-key ess-rdired-mode-map "\C-p" 'ess-rdired-previous-line)
(define-key ess-rdired-mode-map "\C-c\C-s" 'ess-rdired-switch-process)
(define-key ess-rdired-mode-map "\C-c\C-y" 'ess-switch-to-ESS)
(define-key ess-rdired-mode-map "\C-c\C-z" 'ess-switch-to-end-of-ESS)
(define-key ess-rdired-mode-map [down] 'ess-rdired-next-line)
(define-key ess-rdired-mode-map [up] 'ess-rdired-previous-line)
(define-key ess-rdired-mode-map "g" 'revert-buffer)
(if (featurep 'xemacs)
(define-key ess-rdired-mode-map [button2] 'ess-rdired-mouse-view)
(define-key ess-rdired-mode-map [mouse-2] 'ess-rdired-mouse-view)
)
ess-rdired-mode-map))
(defun ess-rdired-mode ()
"Major mode for output from `ess-rdired'.
`ess-rdired' provides a dired-like mode for R objects. It shows the
list of current objects in the current environment, one-per-line. You
can then examine these objects, plot them, and so on.
\\{ess-rdired-mode-map}"
(make-local-variable 'revert-buffer-function)
(setq revert-buffer-function 'ess-rdired-revert-buffer)
(use-local-map ess-rdired-mode-map)
(setq major-mode 'ess-rdired-mode)
(setq mode-name (concat "RDired " ess-local-process-name))
(run-mode-hooks 'ess-rdired-mode-hook))
(defun ess-rdired-mode-hook nil
"Run upon entering `ess-rdired-mode'.")
(defvar ess-rdired-sort-num nil)
(defun ess-rdired ()
"Run dired-like mode on R objects.
This is the main function. See documentation for `ess-rdired-mode' though
for more information!"
(interactive)
(let ((proc ess-local-process-name)
(buff (get-buffer-create ess-rdired-buffer)))
(ess-command ess-rdired-objects buff)
(ess-setq-vars-local (symbol-value ess-local-customize-alist) buff)
(with-current-buffer buff
(setq ess-local-process-name proc)
(ess-rdired-mode)
(goto-char (point-min))
(delete-region (point-min) (1+ (point-at-eol)))
(setq ess-rdired-sort-num 1)
(ess-rdired-insert-set-properties (save-excursion
(goto-char (point-min))
(forward-line 1)
(point))
(point-max))
(setq buffer-read-only t)
)
(pop-to-buffer buff)
))
(defun ess-rdired-object ()
"Return name of object on current line.
Handle special case when object contains spaces."
(save-excursion
(beginning-of-line)
(forward-char 2)
(cond ((looking-at " ")
nil)
((looking-at "\"")
(let (beg)
(setq beg (point))
(forward-char 1)
(search-forward "\"")
(buffer-substring-no-properties beg (point))))
(t
(let (beg)
(setq beg (point))
(search-forward " ")
(buffer-substring-no-properties beg (1- (point))))))))
(defun ess-rdired-edit ()
"Edit (fix) the object at point."
(interactive)
(let ((objname (ess-rdired-object)))
(ess-command (concat "edit(" objname ")\n"))))
(defun ess-rdired-view ()
"View the object at point."
(interactive)
(let ((objname (ess-rdired-object)))
(ess-execute (ess-rdired-get objname)
nil "R view" )))
(defun ess-rdired-get (name)
"Generate R code to get the value of the variable name.
This is complicated because some variables might have spaces in their names.
Otherwise, we could just pass the variable name directly to *R*."
(concat "get(" (ess-rdired-quote name) ")")
)
(defun ess-rdired-quote (name)
"Quote name if not already quoted."
(if (equal (substring name 0 1) "\"")
name
(concat "\"" name "\"")))
(defun ess-rdired-View ()
"View the object at point in its own buffer.
Like `ess-rdired-view', but the object gets its own buffer name."
(interactive)
(let ((objname (ess-rdired-object)))
(ess-execute (ess-rdired-get objname)
nil (concat "R view " objname ))))
(defun ess-rdired-plot ()
"Plot the object on current line."
(interactive)
(let ((objname (ess-rdired-object)))
(ess-eval-linewise (format "plot(%s)" (ess-rdired-get objname)))))
(defun ess-rdired-type ()
"Run the mode() on command at point.
Named type because of similarity with the dired command bound to
y key."
(interactive)
(let ((objname (ess-rdired-object))
(tmpbuf (get-buffer-create "**ess-rdired-mode**")))
(if objname
(progn
(ess-command (concat "mode(" (ess-rdired-get objname) ")\n")
tmpbuf )
(set-buffer tmpbuf)
(message (concat
objname ": "
(buffer-substring (+ 4 (point-min)) (1- (point-max)))))
(kill-buffer tmpbuf)))))
(defun ess-rdired-delete (arg)
"Mark the current (or next ARG) objects for deletion.
If point is on first line, all objects are marked for deletion."
(interactive "p")
(ess-rdired-mark "D" arg))
(defun ess-rdired-undelete (arg)
"Unmark the current (or next ARG) objects.
If point is on first line, all objects will be unmarked."
(interactive "p")
(ess-rdired-mark " " arg))
(defun ess-rdired-mark (mark-char arg)
"Mark the object, using MARK-CHAR, on current line (or next ARG lines)."
(let ((buffer-read-only nil)
move)
(if (eq (point-min)
(save-excursion (beginning-of-line) (point)))
(progn
(setq move (point))
(forward-line 1)
(setq arg (count-lines (point) (point-max)))))
(while (and (> arg 0) (not (eobp)))
(setq arg (1- arg))
(beginning-of-line)
(progn
(insert mark-char)
(delete-char 1)
(forward-line 1)))
(if move
(goto-char move))))
(defun ess-rdired-expunge ()
"Delete the marked objects.
User is queried first to check that objects should really be deleted."
(interactive)
(let ((objs "rm(")
(count 0))
(save-excursion
(goto-char (point-min)) (forward-line 1)
(while (< (count-lines (point-min) (point))
(count-lines (point-min) (point-max)))
(beginning-of-line)
(if (looking-at "^D ")
(setq count (1+ count)
objs (concat objs (ess-rdired-object) ", " )))
(forward-line 1)
))
(if (> count 0)
(progn
(setq objs (concat
(substring objs 0 (- (length objs) 2))
")\n"))
(if (yes-or-no-p (format "Delete %d %s " count
(if (> count 1) "objects" "object")))
(progn
(ess-eval-linewise objs nil nil nil 'wait)
(ess-rdired)
)))
(message "no objects set to delete")
)))
(defun ess-rdired-quit ()
"Quit the R dired buffer."
(interactive)
(kill-buffer ess-rdired-buffer))
(defun ess-rdired-revert-buffer (ignore noconfirm)
"Update the buffer list (in case object list has changed).
Arguments IGNORE and NOCONFIRM currently not used."
(ess-rdired))
(defun ess-rdired-help ()
"Show help for `ess-rdired-mode'."
(interactive)
(describe-function 'ess-rdired-mode))
(defun ess-rdired-sort ()
"Sort the rdired output according to one of the columns.
Rotate between the alternative sorting methods."
(interactive)
(setq ess-rdired-sort-num (1+ ess-rdired-sort-num))
(let ((buffer-read-only nil)
(beg (save-excursion
(goto-char (point-min))
(forward-line 1)
(point)))
(end (point-max)))
(if (> ess-rdired-sort-num 3)
(setq ess-rdired-sort-num 1))
(cond ((eq ess-rdired-sort-num 1)
(sort-fields 1 beg end))
((eq ess-rdired-sort-num 2)
(sort-fields 2 beg end))
((eq ess-rdired-sort-num 3)
(sort-numeric-fields 3 beg end)))))
(defun ess-rdired-next-line (arg)
"Move down lines then position at object.
Optional prefix ARG says how many lines to move; default is one line."
(interactive "p")
(forward-line arg)
(ess-rdired-move-to-object))
(defun ess-rdired-previous-line (arg)
"Move up lines then position at object.
Optional prefix ARG says how many lines to move; default is one line."
(interactive "p")
(forward-line (- (or arg 1)))
(ess-rdired-move-to-object))
(defun ess-rdired-move-to-object ()
"Put point at start of object."
(beginning-of-line)
(forward-char 2)
)
(defun ess-rdired-mouse-view (event)
"In rdired, visit the object on the line you click on."
(interactive "e")
(let (window pos)
(save-excursion
(if (featurep 'xemacs)
(setq window (event-window event)
pos (event-point event))
(setq window (posn-window (event-end event))
pos (posn-point (event-end event))))
(if (not (windowp window))
(error "No file chosen"))
(set-buffer (window-buffer window))
(goto-char pos)
(ess-rdired-view))))
(defun ess-rdired-insert-set-properties (beg end)
"Add mouse highlighting to each object name in the R dired buffer."
(save-excursion
(goto-char beg)
(while (< (point) end)
(ess-rdired-move-to-object)
(add-text-properties
(point)
(save-excursion
(search-forward " ")
(1- (point)))
'(mouse-face highlight
help-echo "mouse-2: view object in other window"))
(forward-line 1))))
(defun ess-rdired-switch-process ()
"Switch to examine different *R* process.
If you have multiple R processes running, e.g. *R*, *R:2*, *R:3*, you can
use this command to choose which R process you would like to examine.
After switching to a new process, the buffer is updated."
(interactive)
(ess-switch-process)
(ess-rdired))