Download
(setq muse-ess-wait-ms 0)
(add-to-list 'muse-publish-markup-tags
'("R" t t nil muse-publish-R-tag))
(add-to-list 'muse-publish-markup-tags
'("Rtext" t t nil muse-publish-Rtext-tag))
(add-to-list 'muse-publish-markup-tags
'("Rplot" t t nil muse-publish-Rplot-tag))
(setq muse-ess-plot-file-name-sep "_")
(defun muse-publish-Rplot-tag (beg end attrs)
(muse-publish-ensure-block beg end)
(muse-publish-markup-attribute
beg end attrs 'verse
(save-excursion
(save-restriction
(let* ((show (cdr (assoc "show" attrs)))
(tag (or (cdr (assoc "tag" attrs)) "muse"))
(debug (cdr (assoc "debug" attrs)))
(proc (cdr (assoc "proc" attrs)))
(type (or (cdr (assoc "type" attrs)) "png"))
(width (or (cdr (assoc "width" attrs)) nil))
(height (or (cdr (assoc "height" attrs)) nil))
(res (or (cdr (assoc "res" attrs)) nil))
(title (or (cdr (assoc "title" attrs)) "R code:"))
(dpi (or (cdr (assoc "dpi" attrs)) "NA"))
(dir (file-name-directory muse-publishing-current-output-path))
(muse-file (file-name-sans-extension (file-name-nondirectory (muse-current-file))))
(count 0)
(file (cond ((cdr (assoc "file" attrs))
(concat dir muse-file
muse-ess-plot-file-name-sep
(cdr (assoc "file" attrs))))
(t (while (file-exists-p (concat dir muse-file muse-ess-plot-file-name-sep "plot-" count "." type))
(setq count (+ count 1)))
(file-exists-p (concat dir muse-file muse-ess-plot-file-name-sep "plot-" count "." type)))))
file-1
(cs (cdr (assoc "coding-system" attrs)))
str
showcode)
(unless (string= (file-name-extension file) type)
(setq file (concat file "." type)))
(setq file-1 (file-name-nondirectory file))
(if show (setq showcode (buffer-substring-no-properties (point-min) (point-max))))
(goto-char (point-min))
(insert
(concat type "(file=\""
file
"\""
(if res (concat ",res=" res))
(if width (concat ",width=" width))
(if height (concat ",height=" height))
")\n"))
(goto-char (point-max))
(insert ".off=dev.off()\n")
(insert "cat(\"\n[[\",\"" file-1 "\",\"]]\n\",sep=\"\")\n")
(message "Processing R code ...")
(setq str (muse-eval-ess
(prog1
(buffer-substring-no-properties
(point-min)
(point-max))
(delete-region (point-min) (point-max))
(widen))
show showcode title tag debug proc cs t))
(set-text-properties 0 (length str) nil str)
(insert str))))))
(defun muse-publish-R-tag (beg end attrs)
(muse-publish-ensure-block beg end)
(muse-publish-markup-attribute
beg end attrs 'verse
(save-excursion
(save-restriction
(let* ((show (cdr (assoc "show" attrs)))
(title (or (cdr (assoc "title" attrs)) "R code:"))
(tag (cdr (assoc "tag" attrs)))
(debug (cdr (assoc "debug" attrs)))
(proc (cdr (assoc "proc" attrs)))
(cs (cdr (assoc "coding-system" attrs)))
showcode
(str (muse-eval-ess
(prog1
(buffer-substring-no-properties
(point-min)
(point-max))
(delete-region (point-min) (point-max))
(widen))
show showcode title tag debug proc cs t)))
(set-text-properties 0 (length str) nil str)
(insert str))))))
(defun muse-publish-Rtext-tag (beg end attrs)
(muse-publish-ensure-block beg end)
(muse-publish-markup-attribute
beg end attrs 'verse
(save-excursion
(save-restriction
(let* ((show (cdr (assoc "show" attrs)))
(title (or (cdr (assoc "title" attrs)) "R code:"))
(tag (cdr (assoc "tag" attrs)))
(debug (cdr (assoc "debug" attrs)))
(proc (cdr (assoc "proc" attrs)))
(cs (cdr (assoc "coding-system" attrs)))
showcode
(str (muse-ess-eval-text
(prog1
(buffer-substring-no-properties
(point-min)
(point-max))
(delete-region (point-min) (point-max))
(widen)))))
(set-text-properties 0 (length str) nil str)
(insert str))))))
(defun muse-eval-ess (code &optional show showcode title tag debug proc coding-system newline)
"This function is used for muse insinuate ess.
If SHOW is non-nil then the R code is shown in a muse-example tag.
If DEBUG is non-nil then the R error and other messages are shown in a
muse-example tag.
Desirable option: If PROC is non-nil the ESS process proc is used."
(let* ((Rproc (condition-case nil
(get-ess-process (or proc "R") nil)
(error nil)))
(buf (get-buffer-create "*ess-mus-temp-buffer*"))
(buf-1 (when debug (get-buffer-create "*ess-mus-mess-buffer*")))
(tag (or tag "src"))
(coding-system-for-read (or coding-system 'iso-8859-1))
mess
res)
(unless Rproc
(save-excursion
(split-window-vertically)
(R)
(delete-window)))
(ess-eval-linewise
"sink(\"/tmp/tag-muse-ess-output.txt\")"
t nil t 'wait nil muse-ess-wait-ms)
(when debug
(ess-eval-linewise "museEssMess <- file(\"/tmp/tag-muse-ess-mess.txt\",open=\"wt\")" t nil t 'wait muse-ess-wait-ms)
(ess-eval-linewise "sink(museEssMess,type=\"message\")" t nil t 'wait muse-ess-wait-ms))
(ess-eval-linewise code 'invisibly nil 'even-empty 'wait muse-ess-wait-ms)
(when debug
(ess-eval-linewise "sink(type=\"message\")" t nil t 'wait muse-ess-wait-ms))
(ess-eval-linewise "sink(NULL)" t nil t 'wait muse-ess-wait-ms)
(save-excursion
(set-buffer buf)
(insert-file-contents
"/tmp/tag-muse-ess-output.txt"
nil nil nil 'replace)
(cond ((string= tag "nil")
(setq res ""))
((string= tag "muse")
(setq res (concat (when newline "\n\n") (buffer-string) (when newline "\n\n"))))
(t (setq res (concat "\n\n<" tag ">\n\n" (buffer-string) "\n\n</" tag ">\n\n")))))
(when debug
(save-excursion
(set-buffer buf-1)
(insert-file-contents "/tmp/tag-muse-ess-mess.txt" nil nil nil 'replace)
(setq mess (buffer-string))))
(unless showcode (setq showcode code))
(cond ((and show (string-match show "beforefirstupBefore"))
(setq res (concat "\n\n<example>\n" title "\n" showcode "\n</example>\n\n" res)))
(show (setq res (concat res "\n\n<example>\n" title "\n" showcode "\n</example>\n\n"))))
(when debug
(setq res (concat res "\n\n<example>\n **Debugging messages from the ESS process "
ess-current-process-name
"**\n" mess "\n\n</example>\n\n")))
res))
(defun muse-ess-eval-text (string)
"Evaluate the R code between a pairs of $$ signs and replace the result."
(let* ((Rproc
(condition-case nil
(get-ess-process (or proc "R") nil)
(error nil)))
(coding-system-for-read 'iso-8859-1)
(tbuffer (get-buffer-create " *ess-code*"))
(ibuffer (get-buffer-create " *ess-res*")))
(unless Rproc
(save-excursion
(split-window-vertically)
(R)
(delete-window)))
(save-excursion
(save-restriction
(set-buffer tbuffer)
(erase-buffer)
(insert string)
(goto-char (point-min))
(while (re-search-forward "\\$\\$" nil t)
(let ((beg (point))
(end (progn (re-search-forward "\\$\\$" nil t)
(re-search-backward "\\$\\$" nil t))))
(ess-command
(concat
(buffer-substring-no-properties beg end)
"\n") ibuffer)
(delete-region (- beg 2) (+ 2 end))
(insert
(replace-in-string
(replace-in-string
(save-excursion
(set-buffer ibuffer)
(buffer-string))
"^\\[[0-9]\\] \\|^\\[+[0-9]+\\]+\n\\|^\n" "")
"\n$" ""))))
(save-excursion
(set-buffer tbuffer)
(buffer-string))
))))
(provide 'muse-ess)