pbm-R-setup.el

(require 'ess-site)
(require 'ess-rutils)

(setq ess-use-tracebug t)
(setq ess-dbg-auto-single-key-p nil)

(setq inferior-R-args "--no-save")

(setq TeX-auto-save t)
(setq TeX-auto-parse-self t)
(setq-default TeX-master nil)
;;;; Sweave/Rnw file editing
;; Linking ESS with AucTex and pgfSweave

;;TODO making hideshow-mode operate over noweb chunks?
(require 'ess-noweb)
(defun ess-swv-pgfSweave ()
   "Run pgfSweave on the current .Rnw file."
   (interactive)
   (ess-swv-run-in-R "pgfSweave"))

(define-key ess-noweb-minor-mode-map "\M-ng" 'ess-swv-pgfSweave)
(define-key inferior-ess-mode-map
  (kbd "C-<up>") 'comint-previous-matching-input-from-input)
(define-key inferior-ess-mode-map
  (kbd "C-<down>") 'comint-next-matching-input-from-input)

(add-hook 'Rnw-mode-hook
 (lambda ()
  (add-to-list 'TeX-command-list
               '("Sweave" "R CMD Sweave %s"
                 TeX-run-command nil (latex-mode) :help "Run Sweave") t)
  (add-to-list 'TeX-command-list
               '("LatexSweave" "%l %(mode) %s"
                 TeX-run-TeX nil (latex-mode) :help "Run Latex after Sweave") t)
  (add-to-list 'TeX-command-list
               '("pgfSweave" "R CMD pgfSweave %s"
                 TeX-run-command nil (latex-mode) :help "Run pgfSweave") t)
  (mapc (lambda (suffix)
          (add-to-list 'TeX-file-extensions suffix))
        '("nw" "Snw" "Rnw"))
  (setq TeX-command-default "pgfSweave")))

;; Fix the ess syntax table: '%' is a quoting character not a
;; punctuation character; but '$' is a punctuation character. Also
;; setup the font-lock to highlight user defined operators,
;; de-emphasizing the % as they are too visually busy.
(add-hook 'R-mode-hook 'pbm-fix-R-syntax-highlighting)
(add-hook 'R-mode-hook 'pbm-R-formatting-preferences)

(defun pbm-fix-R-syntax-highlighting ()
  ;; ESS classes % as punctuation, but it's
  ;; % is really a sort of quote delimiter -- but since it doesn't
  ;; escape with \, there's a slight hole (does anyone use %\% as a
  ;; right matrix divide?)
  (modify-syntax-entry ?% "\"")
  (modify-syntax-entry ?% "\"" font-lock-syntax-table)
  ;; On the other hand ESS classes $ and : as word characters but they
  ;; are really punctuation
  (modify-syntax-entry ?$ ".")
  (modify-syntax-entry ?$ "." font-lock-syntax-table)
  (modify-syntax-entry ?@ ".")
  (modify-syntax-entry ?@ "." font-lock-syntax-table)
  (modify-syntax-entry ?: ".")
  (modify-syntax-entry ?: "." font-lock-syntax-table)
  (setq font-lock-syntactic-face-function 'pbm-R-syntactic-face-function)
  (font-lock-add-keywords nil '((pbm-find-grapes
                                 (0 font-lock-comment-face t)
                                 (1 font-lock-variable-name-face t)
                                 (2 font-lock-comment-face t))))
  (font-lock-add-keywords nil '((pbm-R-find-named
                                 (1 font-lock-variable-name-face t))))
  (font-lock-fontify-buffer))

(ess-add-style 'pbm-style
                 '((ess-indent-level . 2)
                   (ess-arg-function-offset . nil)
                   (ess-arg-function-offset-new-line . '(2))
                   (ess-expression-offset . 2)
                   ))

(defun pbm-R-formatting-preferences ()
  (ess-set-style 'pbm-style)
)

(defun pbm-R-syntactic-face-function (state)
  (cond
   ((nth 3 state) ;strings and stringlike elements
    (case (nth 3 state)
      ;R has four things that are to be tokenized like quotes: single
      ;and double quoted strings, backtick symbols (which are names,
      ;not strings, so they shouldn't be in string face) and %custom%
      ;infix operators.
      ;as well as words preceding =
      (?\" font-lock-string-face)
      (?' font-lock-string-face)
      (?` font-lock-variable-name-face) ;should probably fontify by role
      (?% nil))) ;pbm-find-grapes will handle the highlighting for these?
      ;also words following $ should be highlighted in name face
   (t font-lock-comment-face)))

(defun make-marker-at-location (pos) (set-marker (make-marker) pos))

(defun pbm-find-grapes (&optional limit char)
  "Search for a quote-delimited string and return t if found. Set
   match data 0, 1, 2 to the opening quotes, contents, and closing
   quotes."
  (setq limit (or limit (point-max)))
  (setq char (or char ?%))
  (let ((state (parse-partial-sexp (save-excursion (beginning-of-defun) (point))
                                   (point))))
    (catch 'return
      (while (< (point) limit)
        (setq state (parse-partial-sexp (point) limit
                                        nil nil state 'syntax-table))
        (if (and (nth 3 state) (= (char-after (nth 8 state)) char)) ;in a %op%
            (let ((start (nth 8 state))
                  (end (progn
                         (setq state
                               (parse-partial-sexp (point) limit
                                                   nil nil state 'syntax-table))
                         (point))))
              (when (= (char-before end) char)
                (if (= 2 (- end start)) ;; for %%, highlight the keyword
                    (set-match-data
                     (mapcar 'make-marker-at-location
                             (list start start start end end end)))
                  (set-match-data (mapcar 'make-marker-at-location
                                          (list start (+ start 1)
                                                (+ start 1) (- end 1)
                                                (- end 1) end))))
                (throw 'return t)))))
      nil)))

(require 'thingatpt)
(defun pbm-R-find-named (&optional limit)
  "Search for function argument names, keyword arguments, and
$-field accesses, excluding those in backticks. Return non-nil if
a match is found. Set match-data #1 to the found thing."
  (setq limit (or limit (point-max)))
  (let* ((state (parse-partial-sexp
                 (save-excursion (beginning-of-defun) (point))
                 (point))))
    (catch 'return
      (while t
        (let ((from (point)) ;move to next symbol, parsing
              (to (or (forward-symbol 1) (throw 'return nil))))
          (setq state (parse-partial-sexp from to nil nil state)))
        (when (>= (point) limit) (throw 'return nil))
        (catch 'next
          (when (or (nth 3 state) (nth 4 state))
            (throw 'next nil)) ;skip comments and strings
          (unless (member (char-syntax (char-before (point))) '(?w ?_))
            (throw 'return nil))
          ;;We're looking for these conditions:
          ;;1. preceding the symbol is a $ or a @
          ;;2. we're inside parens, AND
          ;; a.   following the symbol is a single =, OR
          ;; b.   preceding the symbol is either open-paren or comma, AND
          ;;    1. up-parens and preceding symbol is the keyword 'function'
          (cond
           ((looking-back "[$@]\\s *\\(\\(?:\\sw\\|\\s_\\)*\\)") ;it follows $ or @
            (throw 'return t)) ;match data 1 already has the symbol
           ((and (car state)
                 (member (char-after (nth 1 state)) '( ?\( ?\[ ) )) ;in () or []
            (cond
             ((looking-at "\\s *=[^=]") ;symbol precedes =
              (throw 'return (looking-back "\\_<\\(.*\\)")))
             ((and (looking-back "[(,]\\s *\\(?:\\sw\\|\\s_\\)*")
                   (save-excursion
                     (goto-char (nth 1 state))
                     (looking-back "function\\s *"))) ;must be a formal arg
              (throw 'return (looking-back "\\_<\\(.*\\)")))))))))))

;; In iESS mode, fix the shit so that it doesn't get confuzzled by
;; unmatched quotes in output and paredit mode is usable?
(add-hook 'inferior-ess-mode-hook 'pbm-setup-iess-mode)

;restore some ESS keyboard shortcuts that aquamacs disabled?

(defun pbm-setup-iess-mode ()
  (define-key inferior-ess-mode-map (kbd "A-M-p")
    'comint-previous-matching-input-from-input)
  (define-key inferior-ess-mode-map (kbd "A-M-n")
    'comint-next-matching-input-from-input)
  (define-key inferior-ess-mode-map (kbd "C-.")
    (lambda () (interactive) (insert-string "->")))
  (define-key inferior-ess-mode-map (kbd "C-,")
    (lambda () (interactive) (insert-string "<-")))
  (define-key inferior-ess-mode-map (kbd "_") nil)
  (pbm-fix-R-syntax-highlighting)
  )

;eliminate annoying default behaviors for ESS
(add-hook 'ess-mode-hook 'pbm-setup-ess-mode)

(defun pbm-setup-ess-mode ()
  (setq ess-debug-skip-first-call nil)
  (setq ess-inject-source t))

; I_want versions of eval-defun and eval-paragraph that don't step the cursor!
(defun pbm-ess-eval-function-or-paragraph (vis)
  "Does what `ess-eval-function-or-paragraph-and-step' does but leaves point alone."
  (interactive "P")
  (let ((beg-end (ess-eval-function vis 'no-error)))
    (if (null beg-end)
        (ess-eval-paragraph vis)
      (goto-char (cadr beg-end))
      )))

(defun pbm-ess-eval-register-a-b ()
;;; eval the text between registers a and b.
  (interactive)
  (ess-eval-region (get-register ?a) (get-register ?b) nil))

; I like arrow to have its own keyboard shortcut, not double up with underscore.
; Also I usually don't want to stpe the cursor while evaluating, so that
(add-hook 'R-mode-hook 'pbm-make-R-mode-bindings)

(defun pbm-make-R-mode-bindings ()
  (define-key ess-mode-map (kbd "C-.") (lambda () (interactive) (insert-string "->")))
  (define-key ess-mode-map (kbd "C-,") (lambda () (interactive) (insert-string "<-")))
  (define-key ess-mode-map (kbd "_") nil)
  (define-key ess-mode-map (kbd "C-c C-c") 'pbm-ess-eval-function-or-paragraph)
  (define-key ess-mode-map (kbd "C-c c") 'ess-eval-function-or-paragraph-and-step)
  (define-key ess-mode-map (kbd "C-c C-p") 'ess-eval-paragraph)
  (define-key ess-mode-map (kbd "C-c p") 'ess-eval-paragraph-and-step)
  (define-key ess-mode-map (kbd "C-c C-i") 'pbm-ess-eval-register-a-b))

;;hideshowvis-mode.
(add-hook 'R-mode-hook 'hs-minor-mode)
(add-hook 'R-mode-hook 'hideshowvis-enable)

(autoload 'ess-rdired "ess-rdired" "View *R* objects in a dired-like buffer." t)

;; R flymake support.
;; (if Flymake is available) This will call a script
;; "rflymake" with the path given; make sure it is on emac's exec-path
;; or give a full path.
(when (require 'flymake nil)
  (defun flymake-r-init ()
    (let* ((temp-file (flymake-init-create-temp-buffer-copy
                       'flymake-create-temp-inplace))
           (local-file (file-relative-name
                        temp-file
                        (file-name-directory buffer-file-name))))
      (list "~/bin/rflymake" (list local-file))))

  (add-to-list 'flymake-allowed-file-name-masks '("\\.[Rr]\\'" flymake-r-init))
  (add-to-list 'flymake-err-line-patterns
               '("parse(\"\\([^\"]*\\)\"): \\([0-9]+\\):\\([0-9]+\\): \\(.*\\)$"
                 1 2 3 4))
  (add-hook 'R-mode-hook 'flymake-mode)
  )

;;; ---------- R VERSUS PAREDIT --------------------
;;; Paredit mode is
;;; pretty well tied to Lisp syntax. ESS is not a particularly
;;; syntax-aware major mode. Can they be made to work profitably together?

;(add-hook 'R-mode-hook (do-or-warn 'enable-paredit-mode))
(add-hook 'R-mode-hook (lambda () (setq ess-language "R")))
(add-hook 'paredit-mode-hook
          (lambda () (when (and (eq major-mode 'ess-mode) (string= ess-language "R"))
                       (pbm-R-mode-paredit-hook))))

(defun pbm-R-mode-paredit-hook ()
  "Fix up paredit mode so that it works better with R code."
  ;disable automatic space padding
  (make-local-variable 'paredit-space-for-delimiter-predicates)
  (add-to-list 'paredit-space-for-delimiter-predicates
               (lambda (_ _) nil))
  ;; TODO: But DO mak e it so taht curly braces are automatically newline
  ;; padded.

  ;; whatever ess-beginning-of-defun does, I don't like it and nether does paredit.
  (setq beginning-of-defun-function 'pbm-R-beginning-of-defun)

  (pbm-locally-override-minor-mode-key 'paredit-mode (kbd "{") 'paredit-open-curly)
  (pbm-locally-override-minor-mode-key 'paredit-mode (kbd "}") 'paredit-close-curly)

  ;; all four quoting chars in R deserve reasonable paredit-style treatment
  (pbm-locally-override-minor-mode-key 'paredit-mode (kbd "%") 'paredit-anyquote)
  (pbm-locally-override-minor-mode-key 'paredit-mode (kbd "'") 'paredit-anyquote)
  (pbm-locally-override-minor-mode-key 'paredit-mode (kbd "`") 'paredit-anyquote)
  (pbm-locally-override-minor-mode-key 'paredit-mode (kbd "\"") 'paredit-anyquote)

  ;; and our commenting character in R is #, not ;
  (pbm-locally-override-minor-mode-key 'paredit-mode (kbd "#") 'paredit-comment-char)
  (pbm-locally-override-minor-mode-key 'paredit-mode (kbd ";") nil))

;;;Paredit (and other things) really need a "beginning-of-defun" that
;;;always does something reasonable, and ESS's version is dumb anyway
(defun pbm-R-beginning-of-defun ()
  "Move to the beginning of a 'function'. This is defined as some
  line here or above, with a nonwhitespace, noncomment character
  in the first column, that has an unmatched open delimiter or <-
  in that line, preferring the first of consecutive lines that
  meet the criteria, or the first line if all that fails."
  (interactive)
  (and (> (point) (point-min)) (backward-char 1)) ; must move at least one char...
  (forward-line 0)
  (while (and (not (= (line-beginning-position) (point-min)))
              (not (pbm-R-defun-line-looks-ok)))
    (forward-line -1))
  (while (and (not (= (line-beginning-position) (point-min)))
              (save-excursion (previous-line) (pbm-R-defun-line-looks-ok)))
    (forward-line -1)))

(defun pbm-R-defun-line-looks-ok ()
  "return true if the present line could be the start of a 'function'."
  ;is the first line a non-whitespace and non-comment-starter?
  (save-excursion
    (and
     ;; first char must be nonwhitespace and noncomment
     (-> (line-beginning-position) char-after char-syntax (member '(?< ?\ ) ) not)
     (unwind-protect ;this line doesn't close a previously opened brace?
         (parse-partial-sexp (line-beginning-position) (line-end-position)) nil)
     (or (->> ; is there a brace/paren opening?
          (parse-partial-sexp (line-beginning-position) (line-end-position))
          (nth 1))
         (and  ;is there a <- not in a string or comment?
          (progn (forward-line 0) (looking-at ".*<-"))
          (->> (match-data) (nth 1) marker-position
               (parse-partial-sexp (line-beginning-position))
               (slice '(3 4)) (notany 'identity)))))))

; TODO: paredit should insert newlines for braces.

(add-hook 'R-mode-hook 'pbm-R-mode-paredit-hook 1)

(add-hook 'R-mode-hook 'pbm-R-ui-preferences)

(defun pbm-R-ui-preferences ()
  (setq ess-describe-at-point-method 'tooltip)
)

;;; Previewing mode

(add-hook 'ess-mode-hook 'previewing-mode)
(add-hook 'ess-mode-hook 'previewing-r-setup)
(autoload 'previewing-r-setup "previewing-r")

(provide 'pbm-r-setup)