;;; ess-r-syntax.el --- Utils to work with R code

;; Copyright (C) 2015 Lionel Henry

;; Author: Lionel Henry <lionel.hry@gmail.com>
;; Created: 12 Oct 2015
;; Maintainer: ESS-core <ESS-core@r-project.org>

;; This file is part of ESS

;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; A copy of the GNU General Public License is available at
;; http://www.r-project.org/Licenses/

;;; Commentary:

;; API is not yet stable.

;;; Code:


;;*;; Utils

;; The three following wrappers return t if successful, nil on error
(defun ess-backward-sexp (&optional N)
  (ess-forward-sexp (- (or N 1))))

(defun ess-forward-sexp (&optional N)
  (or N (setq N 1))
  (condition-case nil
      (prog1 t
        (goto-char (or (scan-sexps (point) N)
                       (buffer-end N))))
    (error nil)))

(defun ess-up-list (&optional N)
  (condition-case nil
      (progn (up-list N) t)
    (error nil)))

;; Going forth and back is a fast and reliable way of skipping in
;; front of the next sexp despite blanks, newlines and comments that
;; may be in the way.
(defun ess-forth-and-back-sexp ()
  (ess-save-excursion-when-nil
    (and (ess-forward-sexp)
         (ess-backward-sexp))))

(defun ess-back-and-forth-sexp ()
  (ess-save-excursion-when-nil
    (and (ess-backward-sexp)
         (ess-forward-sexp))))

;; Avoids let-binding a variable just to check a returned position is
;; not nil
(defun ess-goto-char (pos)
  (when pos
    (goto-char pos)))

(defun ess-looking-at (regex &optional newlines)
  "Compared to a simple `(looking-at)', this uses sexp motions to
skip any blanks, newlines and comments. Should be more reliable
and possibly faster than using complicated regexes."
  (save-excursion
    (ess-skip-blanks-forward newlines)
    (looking-at regex)))

(defun ess-back-to-indentation ()
  "Move point to the first non-whitespace character on this line.
This non-interactive version of (back-to-indentation) should not
be advised"
  (beginning-of-line 1)
  (skip-syntax-forward " " (line-end-position))
  ;; Move back over chars that have whitespace syntax but have the p flag.
  (backward-prefix-chars))

(defmacro ess-save-excursion-when-nil (&rest body)
  (declare (indent 0)
           (debug (&rest form)))
  `(let ((orig-point (point)))
     (cond ((progn ,@body))
           (t (prog1 nil
                (goto-char orig-point))))))

(defmacro ess-while (test &rest body)
  "Like (while) but return `t' when body gets executed once."
  (declare (indent 1)
           (debug (&rest form)))
  `(let (executed)
     (while ,test
       (setq executed t)
       ,@body)
     executed))

(defmacro ess-at-indent-point (&rest body)
  (declare (indent 0)
           (debug (&rest form)))
  `(save-excursion
     (goto-char indent-point)
     (ess-back-to-indentation)
     (progn ,@body)))

(defmacro ess-at-containing-sexp (&rest body)
  (declare (indent 0)
           (debug (&rest form)))
  '(when (null containing-sexp)
     (error "Internal error: containing-sexp is nil"))
  `(save-excursion
     (goto-char containing-sexp)
     (progn ,@body)))

(defmacro ess-any (&rest forms)
  "Evaluates all arguments and return non-nil if one of the
arguments is non-nil. This is useful to trigger
side-effects. FORMS follows the same syntax as arguments to
`(cond)'."
  (declare (indent 0) (debug nil))
  `(let ((forms (list ,@(mapcar (lambda (form) `(progn ,@form)) forms))))
     (some 'identity (mapcar 'eval forms))))


;;*;; Point predicates

(defun ess-point-in-call-p (&optional call)
  "Is point in a function or indexing call?"
  (let ((containing-sexp (or (bound-and-true-p containing-sexp)
                             (ess-containing-sexp-position))))
    (save-excursion
      (and (prog1 (ess-goto-char containing-sexp)
             (ess-climb-chained-delims))
           (save-excursion
             (forward-char)
             (ess-up-list))
           (or (ess-looking-at-call-opening "(")
               (looking-at "\\["))
           (ess-point-on-call-name-p call)))))

(defun ess-point-in-continuation-p ()
  (unless (or (looking-at ",")
              (ess-looking-at-call-opening "[[(]"))
    (or (save-excursion
          (ess-jump-object)
          (and (not (ess-looking-at-parameter-op-p))
               (ess-looking-at-operator-p)))
        (save-excursion
          (ess-climb-object)
          (ess-climb-operator)
          (and (ess-looking-at-operator-p)
               (not (ess-looking-at-parameter-op-p)))))))

(defun ess-point-on-call-name-p (&optional call)
  (save-excursion
    (ess-climb-call-name call)))

(defun ess-point-in-prefixed-block-p (&optional call)
  "Is point in a prefixed block? Prefixed blocks refer to the
blocks following function declarations, control flow statements,
etc.

If CALL not nil, check if the prefix corresponds to CALL. If nil,
return the prefix."
  (save-excursion
    (ess-climb-outside-prefixed-block call)))

(defun ess-point-in-comment-p (&optional state)
  (let ((state (or state (syntax-ppss))))
        (eq (syntax-ppss-context state) 'comment)))

(defun ess-point-in-string-p (&optional state)
  (let ((state (or state (syntax-ppss))))
        (eq (syntax-ppss-context state) 'string)))


;;*;; Syntactic Travellers and Predicates

;;;*;;; Blanks, Characters and Comments

(defun ess-skip-blanks-backward (&optional newlines)
  "Skip blanks and newlines backward, taking end-of-line comments
into account."
  (ess-any ((ess-skip-blanks-backward-1))
           ((when newlines
              (ess-while (and (/= (point) (point-min))
                              (= (point) (line-beginning-position)))
                (forward-line -1)
                (goto-char (ess-code-end-position))
                (ess-skip-blanks-backward-1))))))

(defun ess-skip-blanks-backward-1 ()
  (and (/= (point) (point-min))
       (/= 0 (skip-chars-backward " \t"))))

(defun ess-skip-blanks-forward (&optional newlines)
  "Skip blanks and newlines forward, taking end-of-line comments
into account."
  (ess-any ((/= 0 (skip-chars-forward " \t")))
           ((ess-while (and newlines
                            (= (point) (ess-code-end-position))
                            (when (ess-save-excursion-when-nil
                                    ;; Handles corner cases such as point being on last line
                                    (let ((orig-point (point)))
                                      (forward-line)
                                      (ess-back-to-indentation)
                                      (> (point) orig-point)))
                              (skip-chars-forward " \t")
                              t))))))

(defun ess-jump-char (char)
  (ess-save-excursion-when-nil
    (ess-skip-blanks-forward t)
    (when (looking-at char)
      (goto-char (match-end 0)))))

(defun ess-climb-comment ()
  (when (and (ess-point-in-comment-p)
             (not (ess-roxy-entry-p)))
    (prog1 (comment-beginning)
     (skip-chars-backward "#+[ \t]*"))))

(defun ess-looking-back-closing-p ()
  (memq (char-before) '(?\] ?\} ?\))))

(defun ess-looking-back-boundary-p ()
  (looking-back "[][ \t\n(){},]" (1- (point))))


;;;*;;; Blocks

(defun ess-block-opening-p ()
  (save-excursion
    (cond
     ((looking-at "{"))
     ;; Opening parenthesis not attached to a function opens up a
     ;; block too. Only pick up those that are last on their line
     ((ess-looking-at-block-paren-p)))))

(defun ess-block-closing-p ()
  (save-excursion
    (cond
     ((looking-at "}"))
     ((looking-at ")")
      (forward-char)
      (backward-sexp)
      (not (looking-back
            (concat ess-R-name-pattern "[[:blank:]]*")
            (line-beginning-position)))))))

(defun ess-block-p ()
  (or (save-excursion
        (when containing-sexp
          (goto-char containing-sexp)
          (ess-block-opening-p)))
      (ess-unbraced-block-p)))

;; Parenthesised expressions
(defun ess-looking-at-block-paren-p ()
  (and (looking-at "(")
       (not (ess-looking-back-attached-name-p))))

(defun ess-climb-block (&optional ignore-ifelse)
  (ess-save-excursion-when-nil
    (cond
     ((and (not ignore-ifelse)
           (ess-climb-if-else 'to-start)))
     ((and (eq (char-before) ?\})
           (prog2
               (forward-char -1)
               (ess-up-list -1)
             (ess-climb-block-prefix)))))))

(defvar ess-prefixed-block-patterns
  (mapcar (lambda (fun) (concat fun "[ \t\n]*("))
          '("function" "if" "for" "while")))

(defun ess-looking-at-prefixed-block-p (&optional call)
  (if call
      (looking-at (concat call "[ \t]*("))
    (some 'looking-at ess-prefixed-block-patterns)))

(defun ess-unbraced-block-p (&optional ignore-ifelse)
  "This indicates whether point is in front of an unbraced
prefixed block following a control flow statement. Returns
position of the control flow function (if, for, while, etc)."
  (save-excursion
    (and (ess-backward-sexp)
         (or (and (looking-at "else\\b")
                  (not ignore-ifelse))
             (and (looking-at "(")
                  (ess-backward-sexp)
                  (some 'looking-at ess-prefixed-block-patterns)
                  (if ignore-ifelse
                      (not (looking-at "if\\b"))
                    t)))
         (point))))

(defun ess-climb-block-prefix (&optional call ignore-ifelse)
  "Climb the prefix of a prefixed block. Prefixed blocks refer to
the blocks following function declarations, control flow
statements, etc.

Should be called either in front of a naked block or in front
of the curly brackets of a braced block.

If CALL not nil, check if the prefix corresponds to CALL. If nil,
return the prefix."
  (ess-save-excursion-when-nil
    (or (and (not ignore-ifelse)
             (prog1 (and (ess-climb-if-else-call)
                         (or (null call)
                             (looking-at call)))
               (when (looking-at "else\\b")
                 (ess-skip-curly-backward))))
        (let ((pos (ess-unbraced-block-p ignore-ifelse)))
          (and (ess-goto-char pos)
               (if call
                   (looking-at call)
                 (cond ((looking-at "function")
                        "function")
                       ((looking-at "for")
                        "for")
                       ((looking-at "if")
                        "if")
                       ((looking-at "else")
                        "else"))))))))

(defun ess-climb-outside-prefixed-block (&optional call)
  "Climb outside of a prefixed block."
  (let ((containing-sexp (or (bound-and-true-p containing-sexp)
                             (ess-containing-sexp-position))))
    (or (ess-save-excursion-when-nil
          (and (ess-goto-char containing-sexp)
               (looking-at "{")
               (ess-climb-block-prefix call)))
        (ess-climb-outside-unbraced-block call))))

(defun ess-climb-outside-unbraced-block (&optional call)
  (ess-save-excursion-when-nil
    (while (and (not (ess-unbraced-block-p))
                (or (ess-climb-outside-continuations)
                    (ess-climb-outside-call))))
    (ess-climb-block-prefix call)))

(defun ess-jump-block ()
  (cond
   ;; if-else blocks
   ((ess-jump-if-else))
   ;; Prefixed blocks such as `function() {}'
   ((ess-looking-at-prefixed-block-p)
    (ess-jump-prefixed-block))
   ;; Naked blocks
   ((and (or (looking-at "{")
             (ess-looking-at-block-paren-p))
         (ess-forward-sexp)))))

(defun ess-jump-prefixed-block (&optional call)
  (ess-save-excursion-when-nil
    (when (ess-looking-at-prefixed-block-p call)
      (ess-forward-sexp 2)
      (ess-skip-blanks-forward t)
      (if (looking-at "{")
          (ess-forward-sexp)
        (prog1 (ess-jump-expression)
          (ess-jump-continuations))))))


;;;*;;; Calls

(defun ess-call-closing-p ()
  (save-excursion
    (when (cond ((looking-at ")")
                 (ess-up-list -1))
                ((looking-at "]")
                 (when (ess-up-list -1)
                   (prog1 t (ess-climb-chained-delims)))))
      (ess-looking-back-attached-name-p))))

(defun ess-looking-at-call-opening (pattern)
  (and (looking-at pattern)
       (ess-looking-back-attached-name-p)))

;; Should be called just before the opening brace
(defun ess-looking-back-attached-name-p ()
  (save-excursion
    (ess-climb-object)))

(defun ess-looking-at-parameter-op-p ()
  "Are we looking at a function argument? To be called just
before the `=' sign."
  (save-excursion
    (and (looking-at "[ \t]*=[^=]")
         (ess-climb-object)
         (looking-back "[(,][ \t\n]*" (line-beginning-position 0)))))

(defun ess-looking-at-arg-p ()
  (save-excursion
    (ess-jump-arg)))

(defun ess-looking-at-parameter-p ()
  (save-excursion
    (ess-jump-parameter)))

(defun ess-jump-parameter ()
  (ess-save-excursion-when-nil
    (and (ess-jump-name)
         (when (looking-at "[ \t]*=\\([^=]\\)")
           (goto-char (match-beginning 1))
           (ess-skip-blanks-forward)
           t))))

(defun ess-jump-arg ()
  (ess-save-excursion-when-nil
    (ess-skip-blanks-forward t)
    (ess-any ((ess-jump-parameter))
             ((ess-jump-expression))
             ((ess-jump-continuations)))))

(defun ess-arg-bounds ()
  "Should be called in front of the argument."
  (save-excursion
    (let ((beg (point)))
      (and (ess-jump-arg)
           (list beg (point))))))

(defun ess-climb-call (&optional call)
  "Climb functions (e.g. ggplot) and parenthesised expressions."
  (or (ess-while (ess-save-excursion-when-nil
                   (ess-climb-name)
                   (and (ess-climb-chained-delims ?\])
                        ;; (ess-climb-expression)
                        (if (eq (char-before) ?\))
                            (ess-climb-call)
                          (ess-climb-name))
                        )))
      (ess-save-excursion-when-nil
        (when (and (memq (char-before) '(?\] ?\) ?\}))
                   (ess-backward-sexp))
          (if call
              (and (ess-climb-name)
                   (looking-at call)))
          (prog1 t
            (ess-climb-name))))))

(defun ess-climb-call-name (&optional call)
  (ess-save-excursion-when-nil
    (ess-jump-name)
    (ess-skip-blanks-forward)
    (and (ess-looking-at-call-opening "[[(]")
         (ess-climb-name)
         (or (null call)
             (looking-at call)))))

(defun ess-step-to-first-arg ()
  (let ((containing-sexp (ess-containing-sexp-position)))
    (cond ((ess-point-in-call-p)
           (goto-char containing-sexp)
           (forward-char)
           t)
          ((ess-point-on-call-name-p)
           (ess-jump-name)
           (ess-skip-blanks-forward)
           (forward-char)
           t))))

(defun ess-jump-to-next-arg ()
  (and (ess-jump-arg)
       (prog1 (ess-jump-char ",")
         (ess-skip-blanks-forward t))))

(defun ess-jump-call ()
  (ess-save-excursion-when-nil
    (or (and (ess-jump-object)
             (cond ((eq (char-before) ?\)))
                   ((looking-at "\\[")
                    (ess-jump-chained-brackets))
                   ((looking-at "(")
                    (ess-forward-sexp))))
        (and (looking-at "[ \t]*(")
             (ess-forward-sexp)))))

(defun ess-looking-at-call-p ()
  (save-excursion
    (ess-jump-object)
    (ess-skip-blanks-forward)
    (looking-at "[[(]")))

(defun ess-climb-chained-delims (&optional delim)
  "Should be called with point between delims, e.g. `]|['."
  (setq delim (if delim
                  (list delim)
                '(?\] ?\))))
  (ess-while (ess-save-excursion-when-nil
               (when (memq (char-before) delim)
                 (ess-backward-sexp)))))

(defun ess-jump-chained-brackets ()
  (ess-while (ess-save-excursion-when-nil
               (when (eq (char-after) ?\[)
                 (ess-forward-sexp)))))

(defun ess-climb-outside-call (&optional call)
  (let ((containing-sexp (ess-containing-sexp-position)))
    (if (ess-point-in-call-p)
        (ess-save-excursion-when-nil
          (goto-char containing-sexp)
          (ess-climb-chained-delims)
          (and (ess-climb-name)
               (or (null call)
                   (looking-at call))))
      ;; At top level or inside a block, check if point is on the
      ;; function name.
      (ess-save-excursion-when-nil
        (let ((orig-pos (point)))
          (and (ess-jump-name)
               (looking-at "[[(]")
               (ess-climb-name)
               (or (null call)
                   (looking-at call))
               (/= (point) orig-pos)))))))

(defun ess-climb-outside-calls ()
  (ess-while (ess-climb-outside-call)))

(defun ess-jump-inside-call ()
  (ess-save-excursion-when-nil
    (when (ess-jump-name)
      (ess-skip-blanks-forward)
      (when (looking-at "(")
        (forward-char)
        t))))

(defun ess-args-bounds (&optional marker)
  (let ((containing-sexp (ess-containing-sexp-position)))
    (when (ess-point-in-call-p)
      (save-excursion
        (let ((beg (1+ containing-sexp))
              (call-beg (ess-at-containing-sexp
                          (ess-climb-name)
                          (point))))
          ;; (ess-up-list) can't find its way when point is on a
          ;; backquoted name, so start from `beg'.
          (and (goto-char beg)
               (ess-up-list)
               (prog1 t
                 (forward-char -1))
               (let ((end (if marker
                              (point-marker)
                            (point))))
                 (list beg end call-beg))))))))

(defun ess-args-alist ()
  "Return all arguments as an alist with cars set to argument
names and cdrs set to the expressions given as argument. Both
cars and cdrs are returned as strings."
  (save-excursion
    (when (ess-step-to-first-arg)
      (let (args current-arg)
        (while (and (setq current-arg (ess-cons-arg))
                    (setq args (nconc args (list current-arg)))
                    (ess-jump-to-next-arg)))
        args))))

(defun ess-cons-arg ()
  "Return a cons cell of the current argument with car set to the
parameter name (nil if not specified) and cdr set to the argument
expression."
  (save-excursion
    (ess-skip-blanks-forward t)
    (let ((param (when (ess-looking-at-parameter-p)
                   (buffer-substring-no-properties
                    (point)
                    (prog2
                        (ess-jump-name)
                        (point)
                      (ess-jump-char "=")
                      (ess-skip-blanks-forward)))))
          (arg (buffer-substring-no-properties
                (point)
                (progn
                  (ess-jump-arg)
                  (point)))))
      (cons param arg))))


;;;*;;; Statements

(defun ess-looking-back-operator-p (&optional fun-arg)
  (save-excursion
    (and (ess-climb-operator)
         (if (not fun-arg)
             (not (ess-looking-at-parameter-op-p))
           t))))

(defun ess-climb-lhs (&optional no-fun-arg climb-line)
  (ess-save-excursion-when-nil
    (let ((start-line (line-number-at-pos)))
      (ess-climb-operator)
      (when (and (or climb-line (equal (line-number-at-pos) start-line))
                 (ess-looking-at-definition-op-p no-fun-arg))
        (prog1 t
          (ess-climb-expression))))))

(defun ess-jump-lhs ()
  (ess-save-excursion-when-nil
    (and (ess-jump-name)
         (ess-looking-at-definition-op-p)
         (ess-jump-operator))))

;; Useful to check presence of operators. Need to check for
;; (point-min) because that won't work if there is no previous sexp
;; Should be called right at the beginning of current sexp.
(defun ess-climb-operator ()
  (ess-save-excursion-when-nil
    (let ((orig-pos (point)))
      (while (forward-comment -1))
      (cond ((memq (char-before) '(?, ?\;))
             nil)
            ((eq (char-before) ?%)
             (forward-char -1)
             (skip-chars-backward "^%")
             (forward-char -1)
             (ess-skip-blanks-backward)
             t)
            ;; Fixme: Don't use SEXP motion, simply check for ops
            ((ess-backward-sexp)
             ;; When there is only empty space or commented code left to
             ;; climb (e.g. roxygen documentation), there is no previous
             ;; SEXP, but (ess-backward-sexp) will nevertheless climb the
             ;; empty space without failing. So we need to skip it.
             (while (forward-comment 1))
             ;; Handle %op% operators
             (when (and (< (point) orig-pos)
                        (ess-forward-sexp)
                        (ess-looking-at-operator-p))
               (prog1 t
                 (when (and (equal (char-after) ?=)
                            (equal (char-before) ?:))
                   (forward-char -1)
                   (ess-skip-blanks-backward)))))))))

;; Currently doesn't check that the operator is not binary
(defun ess-climb-unary-operator ()
  (ess-save-excursion-when-nil
    (ess-skip-blanks-backward t)
    (when (memq (char-before) '(?+ ?- ?! ?? ?~))
      (forward-char -1)
      t)))

;; Currently returns t if we climbed lines, nil otherwise.
(defun ess-climb-continuations (&optional cascade ignore-ifelse)
  (let ((start-line (line-number-at-pos))
        (moved 0)
        (last-pos (point))
        last-line prev-point def-op expr)
    (setq last-line start-line)
    (when (ess-while (and (<= moved 1)
                          (or (ess-save-excursion-when-nil
                                (and (ess-climb-operator)
                                     (ess-climb-continuations--update-state 'op)
                                     (ess-climb-expression ignore-ifelse)))
                              (ess-climb-unary-operator))
                          (/= last-pos (point)))
            (ess-climb-continuations--update-state)
            (setq last-pos (point)))
      (when (and prev-point
                 (or (= moved 3)
                     (not expr)))
        (goto-char prev-point))
      (if def-op 'def-op (< (line-number-at-pos) start-line)))))

(defun ess-climb-continuations--update-state (&optional op)
  ;; Climbing multi-line expressions should not count as moving up
  (when op
    (setq expr (ess-looking-back-closing-p)))
  (let ((cur-line (line-number-at-pos)))
    (when (and last-line
               (< cur-line last-line)
               (or cascade (not expr)))
      (setq moved (1+ moved))
      (setq last-line cur-line)))
  ;; Don't update counter after climbing operator or climbing too high
  (when (and (not op)
             (<= moved 1))
    (setq prev-point (point)))
  (when (and (ess-looking-at-definition-op-p)
             (<= moved 1))
    (setq def-op t))
  t)

(defun ess-jump-operator ()
  (when (ess-looking-at-operator-p)
    (goto-char (match-end 1))
    (ess-skip-blanks-forward t)
    t))

(defun ess-jump-continuation ()
  (and (ess-jump-operator)
       (ess-jump-expression)))

(defun ess-jump-continuations ()
  (let (last-pos)
    (when (ess-while (and (or (null last-pos)
                              (/= (point) last-pos))
                          (setq last-pos (point))
                          (ess-jump-continuation)))
      ;; In calls, operators can start on newlines
      (let ((start-line (line-number-at-pos)))
        (when (ess-save-excursion-when-nil
                (and (ess-point-in-call-p)
                     (ess-skip-blanks-forward t)
                     (/= (line-number-at-pos) start-line)
                     (ess-looking-at-operator-p)))
          (ess-jump-continuations)))
      t)))

(defun ess-looking-at-continuation-p (&optional or-parameter)
  (or (save-excursion
        (ess-skip-blanks-backward t)
        (ess-back-and-forth-sexp)
        (when (ess-looking-at-operator-p)
          (if or-parameter t
            (not (ess-looking-at-parameter-op-p)))))
      (save-excursion
        (ess-climb-block-prefix))
      (save-excursion
        (or (looking-at "else\\b")
            (ess-climb-if-else-call)))))

(defvar ess-R-operator-pattern "<-\\|:=\\|!=\\|%[^ \t]*%\\|[-:+*/><=&|~]"
  "Regular expression for an operator")

(defvar ess-R-definition-op-pattern "<<?-\\|:=\\|~"
  "Regular expression for a definition operator")

(defun ess-looking-at-operator-p ()
  (looking-at (concat "[[:blank:]]*\\(" ess-R-operator-pattern "\\)")))

(defun ess-looking-at-definition-op-p (&optional no-fun-arg)
  (save-excursion
    (skip-chars-forward "[ \t]")
    (or (looking-at ess-R-definition-op-pattern)
        (and (looking-at "=[^=]")
             (if no-fun-arg
                 (not (ess-looking-at-parameter-op-p))
               t)))))

(defun ess-looking-at-assignment-op-p ()
  (save-excursion
    (ess-skip-blanks-forward t)
    (and (looking-at "<-\\|=")
         (not (ess-looking-at-parameter-op-p)))))

(defun ess-looking-back-definition-op-p (&optional no-fun-arg)
  (save-excursion
    (and (ess-backward-sexp)
         (ess-forward-sexp)
         (ess-looking-at-definition-op-p no-fun-arg))))

(defun ess-climb-outside-continuations ()
  (ess-any ((unless (ess-looking-back-boundary-p)
              (ess-climb-expression)))
           ((ess-while (ess-climb-continuations)))))

(defun ess-continuations-bounds (&optional marker)
  (save-excursion
    (let ((orig-point (point))
          (beg (progn
                 (ess-climb-outside-continuations)
                 (point))))
      (when beg
        (ess-jump-expression)
        (ess-jump-continuations)
        (let ((end (if marker
                       (point-marker)
                     (point))))
          (list beg end))))))

(defun ess-climb-to-top-level ()
  (while (ess-goto-char (ess-containing-sexp-position)))
  (ess-climb-outside-continuations))


;;;*;;; Statements: Control Flow

(defun ess-climb-if-else-call (&optional multi-line)
  "Climb if, else, and if else calls."
  (ess-save-excursion-when-nil
    (ess-backward-sexp)
    (cond ((looking-at "(")
           (when (and (ess-backward-sexp)
                      (looking-at "if\\b"))
             ;; Check for `else if'
             (prog1 t
               (ess-save-excursion-when-nil
                 (let ((orig-line (line-number-at-pos)))
                   (and (ess-backward-sexp)
                        (or multi-line
                            (eq orig-line (line-number-at-pos)))
                        (looking-at "else\\b")))))))
          ((looking-at "else\\b")))))

(defun ess-climb-if-else-body (&optional from-else)
  (cond
   ;; Climb braced body
   ((ess-save-excursion-when-nil
      (and (when (progn (ess-skip-blanks-backward t)
                        (eq (char-before) ?\}))
             (prog1 t (forward-char -1)))
           (ess-up-list -1))))
   ;; Climb unbraced body
   ((when from-else
      (ess-save-excursion-when-nil
        (ess-skip-blanks-backward t)
        (prog1 (ess-climb-expression 'ignore-ifelse)
          (or (ess-climb-continuations nil 'ignore-ifelse)
              (ess-climb-block-prefix nil 'ignore-ifelse))))))))

(defun ess-climb-if-else (&optional to-start)
  "Climb horizontal as well as vertical if-else chains, with or
without curly braces."
  ;; Don't climb if we're atop the current chain of if-else
  (unless (looking-at "if\\b")
    (ess-save-excursion-when-nil
      (let ((from-else (looking-at "else\\b")))
        (when (and (ess-climb-if-else-body from-else)
                   (ess-climb-if-else-call to-start))
          ;; If we start from a final else and climb to another else, we
          ;; are in the wrong chain of if-else. In that case,
          ;; climb-recurse to the top of the current chain and climb
          ;; again to step in the outer chain.
          (when (and from-else (ess-looking-at-final-else))
            (ess-climb-if-else 'to-start)
            (ess-climb-continuations)
            (ess-climb-block-prefix nil 'ignore-ifelse)
            (ess-climb-if-else-call nil))
          (ess-maybe-climb-broken-else)
          (when to-start
            (ess-climb-if-else to-start))
          t)))))

;; Handles multi-line such as if \n else, with comments in the way etc
(defun ess-looking-at-final-else ()
  (or (save-excursion
        (and (looking-at "else\\b")
             (ess-forward-sexp)
             (ess-forth-and-back-sexp)
             (not (looking-at "if\\b"))))))

;; Broken else: if \n else
(defun ess-maybe-climb-broken-else (&optional same-line)
  (ess-save-excursion-when-nil
    ;; Don't record current line if not needed (expensive operation)
    (let ((cur-line (when same-line (line-number-at-pos))))
      (and (ess-backward-sexp)
           (looking-at "else\\b")
           (if same-line
               (= cur-line (line-number-at-pos))
             t)))))

(defun ess-skip-curly-backward ()
  (re-search-backward "}[ \t]*" (line-beginning-position) t))

(defun ess-jump-if-else ()
  (let (from)
    (ess-while (ess-save-excursion-when-nil
                 (ess-skip-blanks-forward t)
                 (cond
                  ((and (not (eq from 'if))
                        (ess-jump-if)
                        (setq from 'if)))
                  ((looking-at "else")
                   (ess-forward-sexp)
                   (or (ess-jump-if)
                       (progn
                         (ess-skip-blanks-forward t)
                         (ess-jump-expression)))
                   (setq from 'else))
                  (t
                   nil))))))

(defun ess-jump-if ()
  (ess-save-excursion-when-nil
    (ess-skip-blanks-forward t)
    (and (looking-at "if[ \t\n]*(")
         (ess-forward-sexp 2)
         (progn
           (ess-skip-blanks-forward t)
           (ess-jump-expression)))))


;;;*;;; Function Declarations

(defun ess-looking-at-defun-p ()
  (or (looking-at "function[ \t]*(")
      (ess-looking-at-enclosed-defun-p)))

(defun ess-looking-at-enclosed-defun-p ()
  (save-excursion
    (and (ess-looking-at-call-p)
         (ess-jump-inside-call)
         (some (lambda (arg)
                 (string-match "^function\\b"
                               (cdr arg)))
               (ess-args-alist)))))


;;;*;;; Names / Objects / Expressions

;; Should  climb any names, including backquoted ones or those
;; containing `@' or `$'. Difficult to achieve with regexps, but
;; skipping chars is faster anyway.
(defun ess-climb-object ()
  (ess-save-excursion-when-nil
    (let (climbed)
      (ess-skip-blanks-backward)
      ;; Backquoted names can contain any character
      (if (and (memq (char-before) '(?` ?\" ?\'))
               (ess-backward-sexp))
          (setq climbed t)
        (while (some (apply-partially '/= 0)
                     `(,(skip-syntax-backward "w_")
                       ,(skip-chars-backward "\"'")))
          (setq climbed t)))
      ;; Recurse if we find an indexing char
      (when (memq (char-before) '(?$ ?@))
        (forward-char -1)
        (ess-climb-object))
      climbed)))

;; Todo: split name and object climbing
(defun ess-climb-name ()
  (ess-climb-object))

;; This jumps both object names and atomic objects like strings or
;; numbers.
(defun ess-jump-object ()
  (cond
   ;; Jump over object names
   ((ess-jump-name))
   ;; Jump over strings))
   ((ess-save-excursion-when-nil
      (skip-chars-forward " \t")
      (memq (char-after) '(?\" ?\')))
    (ess-forward-sexp))))

(defun ess-jump-name ()
  (ess-save-excursion-when-nil
    (let (climbed quote-char)
      (skip-chars-forward " \t")
      ;; Jump over backquoted names
      (cond ((and (eq (char-after) ?`)
                  (looking-back ess-R-symbol-pattern
                                (1- (point))))
             (forward-char)
             (setq climbed t))
            ((eq (char-after) ?`)
             (forward-char)
             (when (ess-while (not (memq (char-after) '(?` ?\C-J)))
                     (forward-char))
               (setq climbed t)
               (forward-char)))
            ;; Jump over regular names
            ((when (/= 0 (skip-syntax-forward "w_"))
               ;; Maybe point was inside backticks
               (when (eq (char-after) ?`)
                 (forward-char))
               (setq climbed t))))
      climbed)))

(defun ess-climb-expression (&optional ignore-ifelse)
  (ess-save-excursion-when-nil
    (or (ess-climb-block ignore-ifelse)
        (ess-climb-call)
        (ess-climb-object))))

(defun ess-jump-expression ()
  (or (ess-jump-block)
      (ess-jump-call)
      (ess-jump-object)))

(provide 'ess-r-syntax)

 ; Local variables section

;;; This file is automatically placed in Outline minor mode.
;;; The file is structured as follows:
;;; Chapters:     ^L ;
;;; Sections:    ;;*;;
;;; Subsections: ;;;*;;;
;;; Components:  defuns, defvars, defconsts
;;;              Random code beginning with a ;;;;* comment

;;; Local variables:
;;; mode: emacs-lisp
;;; outline-minor-mode: nil
;;; mode: outline-minor
;;; outline-regexp: "\^L\\|\\`;\\|;;\\*\\|;;;\\*\\|(def[cvu]\\|(setq\\|;;;;\\*"
;;; End:

;;; ess-r-syntax.el ends here