Klimi's new dotfiles with stow.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

1561 regels
50 KiB

5 jaren geleden
  1. ;;; ess-r-syntax.el --- Utils to work with R code
  2. ;; Copyright (C) 2015 Lionel Henry
  3. ;; Author: Lionel Henry <lionel.hry@gmail.com>
  4. ;; Created: 12 Oct 2015
  5. ;; Maintainer: ESS-core <ESS-core@r-project.org>
  6. ;; This file is part of ESS
  7. ;; This file is free software; you can redistribute it and/or modify
  8. ;; it under the terms of the GNU General Public License as published by
  9. ;; the Free Software Foundation; either version 2, or (at your option)
  10. ;; any later version.
  11. ;; This file is distributed in the hope that it will be useful,
  12. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. ;; GNU General Public License for more details.
  15. ;; A copy of the GNU General Public License is available at
  16. ;; https://www.r-project.org/Licenses/
  17. ;;; Commentary:
  18. ;; API is not yet stable.
  19. ;;; Code:
  20. (require 'ess-utils)
  21. (require 'regexp-opt)
  22. (eval-when-compile
  23. (require 'cl-lib))
  24. ;;*;; Utils
  25. ;; The three following wrappers return t if successful, nil on error
  26. (defun ess-backward-sexp (&optional N)
  27. (ess-forward-sexp (- (or N 1))))
  28. (defun ess-forward-sexp (&optional N)
  29. (or N (setq N 1))
  30. (condition-case nil
  31. (prog1 t
  32. (goto-char (or (scan-sexps (point) N)
  33. (buffer-end N))))
  34. (error nil)))
  35. (defun ess-up-list (&optional N)
  36. (condition-case nil
  37. (let (forward-sexp-function)
  38. (progn (up-list N) t))
  39. (error nil)))
  40. (defun ess-backward-up-list (&optional N)
  41. (ess-up-list (- (or N 1))))
  42. (defun ess-forward-char (&optional N)
  43. (unless (= (point) (point-max))
  44. (forward-char (or N 1))
  45. t))
  46. (defun ess-backward-char (&optional N)
  47. (unless (bobp)
  48. (forward-char (- (or N 1)))
  49. t))
  50. (defun ess-goto-char (pos)
  51. "Go to POS if it is non-nil.
  52. If POS is nil, return nil. Otherwise return position itself."
  53. (when pos
  54. (goto-char pos)))
  55. (defun ess-looking-at (regex &optional newlines)
  56. "Like `looking-at' but consumes blanks and comments first."
  57. (save-excursion
  58. (ess-skip-blanks-forward newlines)
  59. (looking-at regex)))
  60. (defmacro ess-save-excursion-when-nil (&rest body)
  61. (declare (indent 0)
  62. (debug (&rest form)))
  63. `(let ((orig-point (point)))
  64. (cond ((progn ,@body))
  65. (t (prog1 nil
  66. (goto-char orig-point))))))
  67. (defmacro ess-while (test &rest body)
  68. "Like `while' for TEST but return t when BODY gets executed once."
  69. (declare (indent 1)
  70. (debug (&rest form)))
  71. `(let (executed)
  72. (while ,test
  73. (setq executed t)
  74. ,@body)
  75. executed))
  76. (defmacro ess-at-indent-point (&rest body)
  77. (declare (indent 0)
  78. (debug (&rest form)))
  79. `(save-excursion
  80. (goto-char indent-point)
  81. (back-to-indentation)
  82. (progn ,@body)))
  83. (defvar containing-sexp)
  84. (defmacro ess-at-containing-sexp (&rest body)
  85. (declare (indent 0)
  86. (debug (&rest form)))
  87. '(when (not (bound-and-true-p containing-sexp))
  88. (error "Internal error: containing-sexp is nil or undefined"))
  89. `(save-excursion
  90. (goto-char containing-sexp)
  91. (progn ,@body)))
  92. (defmacro ess-any (&rest forms)
  93. "Evaluate all arguments and return non-nil if one of the arguments is non-nil.
  94. This is useful to trigger side-effects. FORMS follows the same
  95. syntax as arguments to `cond'."
  96. (declare (indent 0) (debug nil))
  97. `(let ((forms (list ,@(mapcar (lambda (form) `(progn ,@form)) forms))))
  98. (cl-some 'identity (mapcar 'eval forms))))
  99. (defun ess-char-syntax (string)
  100. (char-to-string (char-syntax (string-to-char string))))
  101. ;;*;; Tokenisation
  102. (defun ess-token-type (token) (car (nth 0 token)))
  103. (defun ess-token-value (token) (cdr (nth 0 token)))
  104. (defun ess-token-start (token) (car (nth 1 token)))
  105. (defun ess-token-end (token) (cdr (nth 1 token)))
  106. (defun ess-token-refined-type (token)
  107. (ess-token-type (ess-refine-token token)))
  108. (defun ess-token-after (&optional token)
  109. "Return next TOKEN.
  110. Cons cell containing the token type and string representation."
  111. (save-excursion
  112. (when token
  113. (goto-char (ess-token-end token)))
  114. (ess-jump-token)))
  115. (defun ess-token-before (&optional token)
  116. "Return previous TOKEN.
  117. Cons cell containing the token type and string representation."
  118. (save-excursion
  119. (when token
  120. (goto-char (ess-token-start token)))
  121. (ess-climb-token)))
  122. (defun ess-climb-token (&optional type string)
  123. (ess-save-excursion-when-nil
  124. (ess-escape-comment)
  125. (ess-skip-blanks-backward t)
  126. (let ((token (or (ess-climb-token--back)
  127. (ess-climb-token--back-and-forth)
  128. (progn (forward-char -1) (ess-token-after)))))
  129. (if (or type string)
  130. (when (ess-token= token type string)
  131. token)
  132. token))))
  133. (defun ess-token--cons (type value)
  134. (if (eq type 'self)
  135. (cons value nil)
  136. (cons type value)))
  137. (defun ess-climb-token--back ()
  138. (let* ((token-end (point))
  139. (token-type (if (bobp)
  140. "buffer-start"
  141. (ess-climb-token--operator)))
  142. (token-value (buffer-substring-no-properties (point) token-end)))
  143. (unless (null token-type)
  144. (list (ess-token--cons token-type token-value)
  145. (cons (point) token-end)))))
  146. (defsubst ess-climb-token--char (&rest chars)
  147. (ess-while (and chars
  148. (eq (char-before) (car chars))
  149. (ess-backward-char))
  150. (setq chars (cdr chars))))
  151. ;; Difficult to use regexps here because we want to match greedily
  152. ;; backward
  153. (defun ess-climb-token--operator ()
  154. (when (pcase (char-before)
  155. ((or `?+ `?/ `?^ `?~ `?? `?!)
  156. (ess-backward-char))
  157. (`?=
  158. (prog1 (ess-backward-char)
  159. (or (ess-climb-token--char ?=)
  160. (ess-climb-token--char ?!)
  161. (ess-climb-token--char ?:)
  162. (ess-climb-token--char ?>)
  163. (ess-climb-token--char ?<))))
  164. ((or `?& `?| `?* `?@ `?$)
  165. (prog1 (ess-backward-char)
  166. (ess-climb-token--char (char-after))))
  167. (`?<
  168. (ess-backward-char))
  169. (`?>
  170. (prog1 (ess-backward-char)
  171. (or (ess-climb-token--char ?-)
  172. (and (looking-back "->" (- (point) 2))
  173. (goto-char (- (point) 2))))))
  174. (`?-
  175. (prog1 (ess-backward-char)
  176. (ess-climb-token--char ?< ?<)))
  177. (`?:
  178. (prog1 (ess-backward-char)
  179. (ess-climb-token--char ?: ?:))))
  180. 'self))
  181. (defun ess-climb-token--back-and-forth ()
  182. (let ((limit (point)))
  183. (when (ess-skip-token-backward)
  184. (save-restriction
  185. (narrow-to-region (point) limit)
  186. (ess-token-after)))))
  187. (defun ess-skip-token-backward ()
  188. (ess-save-excursion-when-nil
  189. (cond
  190. ;; Punctuation
  191. ((memq (char-before) '(?, ?\;))
  192. (ess-backward-char))
  193. ;; Quoting delimiters
  194. ((memq (char-syntax (char-before)) '(?\" ?$))
  195. (ess-backward-sexp))
  196. ;; Syntaxic delimiters
  197. ((memq (char-syntax (char-before)) '(?\( ?\)))
  198. (prog1 (ess-backward-char)
  199. ;; Also skip double brackets
  200. (ess-save-excursion-when-nil
  201. (when (let ((current-delim (char-after)))
  202. (ess-skip-blanks-backward)
  203. (and (memq (char-before) '(?\[ ?\]))
  204. (eq current-delim (char-before))))
  205. (ess-backward-char)))))
  206. ;; Identifiers and numbers
  207. ((/= (skip-syntax-backward "w_") 0)))))
  208. (defun ess-jump-token (&optional type string)
  209. "Consume a token forward.
  210. Return a cons cell containing the token type and the token string
  211. content. Return nil when the end of the buffer is reached."
  212. (ess-save-excursion-when-nil
  213. (ess-skip-blanks-forward t)
  214. (let* ((token-start (point))
  215. (token-type (or (ess-jump-token--regexps)
  216. (ess-jump-token--literal)
  217. (ess-jump-token--infix-op)
  218. (ess-jump-token--punctuation)
  219. (progn (forward-char) "unknown")))
  220. (token-value (buffer-substring-no-properties token-start (point))))
  221. (let ((token (list (ess-token--cons token-type token-value)
  222. (cons token-start (point)))))
  223. (if (or type string)
  224. (when (ess-token= token type string)
  225. token)
  226. token)))))
  227. (defun ess-jump-token--literal ()
  228. (cond
  229. ;; Simply assume anything starting with a digit is a number. May be
  230. ;; too liberal but takes care of fractional numbers, integers such
  231. ;; as 10L, etc. False positives are not valid R code anyway.
  232. ((looking-at "[0-9]")
  233. (ess-forward-sexp)
  234. "number")
  235. ((or (looking-at "\\sw\\|\\s_")
  236. (eq (char-after) ?`))
  237. (ess-forward-sexp)
  238. "identifier")
  239. ((memq (char-after) '(?\" ?\'))
  240. (ess-forward-sexp)
  241. "string")))
  242. (defun ess-jump-token--punctuation ()
  243. (or (when (= (point) (point-max))
  244. "buffer-end")
  245. (pcase (char-after)
  246. (`?\;
  247. (forward-char)
  248. 'self)
  249. (`?,
  250. (forward-char)
  251. ;; Treat blanks after comma as part of an argument
  252. (ess-skip-blanks-forward t)
  253. ","))))
  254. (defvar ess-r-prefix-keywords-list
  255. '("if" "for" "while" "function"))
  256. (defvar ess-r-keywords-list
  257. (append ess-r-prefix-keywords-list '("else")))
  258. (defvar ess-r-delimiters-list
  259. '("(" ")" "{" "}" "[" "]" "[[" "]]"))
  260. (defvar ess-r-operators-list
  261. '("+" "-" "*" "/" "%%" "**" "^"
  262. "&" "&&" "|" "||" "!" "?" "~"
  263. "==" "!=" "<" "<=" ">=" ">"
  264. "=" "<-" "<<-" "->" "->>"
  265. "$" "@" ":" "::" ":::" ":="))
  266. (defvar ess-r-keywords-re
  267. (concat (regexp-opt ess-r-keywords-list) "\\_>"))
  268. (defvar ess-r-delimiters-re
  269. (regexp-opt ess-r-delimiters-list))
  270. (defvar ess-r-operators-re
  271. (regexp-opt ess-r-operators-list))
  272. (defun ess-jump-token--regexps ()
  273. (when (or (looking-at ess-r-keywords-re)
  274. (looking-at ess-r-delimiters-re)
  275. (looking-at ess-r-operators-re))
  276. (goto-char (match-end 0))
  277. 'self))
  278. (defun ess-jump-token--infix-op ()
  279. (or (when (looking-at ess-r-operators-re)
  280. (goto-char (match-end 0))
  281. 'self)
  282. (when (eq (char-after) ?%)
  283. (ess-forward-sexp)
  284. "%infix%")))
  285. (defun ess-escape-token ()
  286. (ess-escape-comment)
  287. (ess-skip-blanks-forward)
  288. (or (ess-escape-string)
  289. (when (ess-token-delimiter-p (ess-token-after))
  290. (prog1 t
  291. (mapc (lambda (delims)
  292. (while (and (ess-token-after= nil delims)
  293. (eq (char-before) (string-to-char
  294. (car delims))))
  295. (ess-backward-char)))
  296. '(("[" "[[") ("]" "]]")))))
  297. (ess-token-after= '("," ";"))
  298. (and (ess-token-after= "identifier")
  299. (not (memq (char-syntax (char-before)) '(?w ?_))))
  300. (progn (skip-syntax-backward ".")
  301. (ess-token-operator-p (ess-token-after)))
  302. (/= (skip-syntax-backward "w_") 0)))
  303. (defun ess-refine-token (token)
  304. (let ((refined-type
  305. (pcase (ess-token-type token)
  306. ;; Parameter assignment
  307. (`"="
  308. (save-excursion
  309. (goto-char (ess-token-start token))
  310. (let ((containing-sexp (ess-containing-sexp-position)))
  311. (when (and containing-sexp
  312. (ess-at-containing-sexp
  313. (and (ess-token-after= "(")
  314. (ess-token-before= '("identifier" "string"))))
  315. (save-excursion
  316. (and (ess-climb-token)
  317. (ess-token-before= '("," "(")))))
  318. "param-assign"))))
  319. ;; Quoted identifiers
  320. (`"string"
  321. (when (or
  322. ;; Quoted parameter names
  323. (ess-refined-token= (ess-token-after) "param-assign")
  324. ;; Quoted call names
  325. (ess-token-after= "("))
  326. "identifier"))
  327. ((or `"(" `")")
  328. (or (save-excursion
  329. (if (ess-token-close-delimiter-p token)
  330. (ess-climb-paired-delims nil token)
  331. (goto-char (ess-token-start token)))
  332. (when (ess-token-keyword-p (ess-token-before))
  333. "prefixed-expr-delimiter"))
  334. ;; Fixme: probably too crude. Better handled in parser
  335. (when (ess-token= token ")")
  336. (save-excursion
  337. (ess-climb-paired-delims ")" token)
  338. (when (ess-token-before= '("identifier" "string" ")" "]" "]]" "}"))
  339. "argslist-delimiter")))))
  340. ((or `"{" `"}")
  341. (save-excursion
  342. (unless (ess-climb-paired-delims "}" token)
  343. (goto-char (ess-token-start token)))
  344. (when (ess-refined-token= (ess-token-before) "prefixed-expr-delimiter")
  345. "prefixed-expr-delimiter"))))))
  346. (if refined-type
  347. (list (cons refined-type (ess-token-value token))
  348. (nth 1 token))
  349. token)))
  350. (defun ess-token-balancing-delim (token)
  351. (pcase (ess-token-type token)
  352. (`"(" ")")
  353. (`")" "(")
  354. (`"[" "]")
  355. (`"]" "[")
  356. (`"[[" "]]")
  357. (`"]]" "[[")))
  358. ;;;*;;; Token predicates
  359. (defun ess-token= (token &optional type string)
  360. (when (and (null type)
  361. (null string))
  362. (error "No condition supplied"))
  363. (let ((type (if (stringp type) (list type) type))
  364. (string (if (stringp string) (list string) string)))
  365. (and (if type (member (ess-token-type token) type) t)
  366. (if string (member (ess-token-value token) string) t))))
  367. (defun ess-refined-token= (token type &optional string)
  368. (ess-token= (ess-refine-token token) type string))
  369. (defun ess-token-after= (type &optional string)
  370. (ess-token= (ess-token-after) type string))
  371. (defun ess-token-before= (type &optional string)
  372. (ess-token= (ess-token-before) type string))
  373. (defun ess-token-open-delimiter-p (token)
  374. (string= (ess-char-syntax (ess-token-type token)) "("))
  375. (defun ess-token-close-delimiter-p (token)
  376. (string= (ess-char-syntax (ess-token-type token)) ")"))
  377. (defun ess-token-delimiter-p (token)
  378. (or (ess-token-open-delimiter-p token)
  379. (ess-token-close-delimiter-p token)))
  380. (defun ess-token-operator-p (token &optional strict)
  381. (and (or (member (ess-token-type token) ess-r-operators-list)
  382. (string= (ess-token-type token) "%infix%"))
  383. (or (null strict)
  384. (not (ess-refined-token= token "param-assign")))))
  385. (defun ess-token-keyword-p (token)
  386. (member (ess-token-type token) ess-r-keywords-list))
  387. ;;;*;;; Tokens properties and accessors
  388. (defun ess-token-make-hash (&rest specs)
  389. (let ((table (make-hash-table :test #'equal)))
  390. (mapc (lambda (spec)
  391. ;; alist
  392. (if (listp (cdr spec))
  393. (mapc (lambda (cell)
  394. (puthash (car cell) (cdr cell) table))
  395. spec)
  396. ;; Cons cell
  397. (mapc (lambda (token)
  398. (puthash token (cdr spec) table))
  399. (car spec))))
  400. specs)
  401. table))
  402. (defvar ess-token-r-powers-delimiters
  403. '(("(" . 100)
  404. ("[" . 100)
  405. ("[[" . 100)))
  406. (defvar ess-token-r-powers-operator
  407. '(("?" . 5)
  408. ("else" . 8)
  409. ("<-" . 10)
  410. ("<<-" . 10)
  411. ("=" . 15)
  412. ("->" . 20)
  413. ("->>" . 20)
  414. ("~" . 25)
  415. ("|" . 30)
  416. ("||" . 30)
  417. ("&" . 35)
  418. ("&&" . 35)
  419. ("!" . 40)
  420. ("<" . 45)
  421. (">" . 45)
  422. ("<=" . 45)
  423. (">=" . 45)
  424. ("==" . 45)
  425. ("+" . 50)
  426. ("-" . 50)
  427. ("*" . 55)
  428. ("/" . 55)
  429. ("%infix%" . 60)
  430. (":" . 65)
  431. ("^" . 70)
  432. ("$" . 75)
  433. ("@" . 75)
  434. ("::" . 80)
  435. (":::" . 80)))
  436. (defvar ess-token-r-power-table
  437. (ess-token-make-hash ess-token-r-powers-operator
  438. ess-token-r-powers-delimiters))
  439. (defvar ess-token-r-right-powers-operator
  440. '((")" . 1)))
  441. (defvar ess-token-r-right-power-table
  442. (ess-token-make-hash ess-token-r-powers-operator
  443. ess-token-r-right-powers-operator))
  444. (defvar ess-token-r-nud-table
  445. (ess-token-make-hash
  446. '(("identifier" . identity)
  447. ("literal" . identity)
  448. ("number" . identity)
  449. ("function" . identity)
  450. ("if" . identity)
  451. ("while" . identity)
  452. ("for" . identity))
  453. '(("(" . ess-parser-nud-block)
  454. ("{" . ess-parser-nud-block))))
  455. (defvar ess-token-r-rnud-table
  456. (ess-token-make-hash
  457. '(("identifier" . identity)
  458. ("literal" . identity)
  459. ("number" . identity))
  460. '((")" . ess-parser-rnud-paren)
  461. ("}" . ess-parser-nud-block))))
  462. (defvar ess-token-r-leds-operator
  463. (let ((operators-list (append '("%infix%" "else") ess-r-operators-list)))
  464. (cons operators-list #'ess-parser-led-lassoc)))
  465. (defvar ess-token-r-leds-delimiter
  466. '(("(" . ess-parser-led-funcall)
  467. ("[" . ess-parser-led-funcall)
  468. ("[[" . ess-parser-led-funcall)))
  469. (defvar ess-token-r-led-table
  470. (ess-token-make-hash ess-token-r-leds-operator
  471. ess-token-r-leds-delimiter))
  472. (defvar ess-token-r-rid-table
  473. (ess-token-make-hash
  474. '((")" . ess-parser-rid-expr-prefix))))
  475. ;;;*;;; Nud, led and rid functions
  476. (defun ess-parser-nud-block (prefix-token)
  477. (let ((right (list (cons "TODO" nil))))
  478. (ess-parser-advance-pair nil prefix-token)
  479. (ess-node (cons "block" nil)
  480. (cons (ess-token-start prefix-token) (point))
  481. (list prefix-token right))))
  482. (defun ess-parser-led-lassoc (start infix-token)
  483. (let* ((power (ess-parser-power infix-token))
  484. (end (ess-parse-expression power)))
  485. (ess-node (cons "binary-op" nil)
  486. (cons (ess-parser-token-start start) (point))
  487. (list start infix-token end))))
  488. (defun ess-parser-led-funcall (left infix-token)
  489. (when (ess-token= left (append '("identifier" "string" "node")
  490. ess-r-prefix-keywords-list))
  491. (let* ((power (ess-parser-power infix-token))
  492. (right (ess-parse-arglist power infix-token))
  493. (type (if (ess-token= left ess-r-prefix-keywords-list)
  494. "prefixed-expr"
  495. "funcall")))
  496. (when (string= type "prefixed-expr")
  497. (setq right (list right (ess-parse-expression 0))))
  498. (ess-node (cons type nil)
  499. (cons (ess-parser-token-start left) (point))
  500. (list left right)))))
  501. (defun ess-parser-rid-expr-prefix (right suffix-token)
  502. (when (ess-refined-token= suffix-token "prefixed-expr-delimiter")
  503. (ess-parser-rnud-paren suffix-token right)))
  504. (defun ess-parser-rnud-paren (suffix-token &optional prefixed-expr)
  505. (let* ((infix-token (save-excursion
  506. (ess-parser-advance-pair nil suffix-token)))
  507. (power (ess-parser-power infix-token))
  508. (args (ess-parse-arglist power suffix-token))
  509. (left (if prefixed-expr
  510. (ess-parser-advance)
  511. (ess-parse-expression power)))
  512. (type (cond (prefixed-expr "prefixed-expr")
  513. (left "funcall")
  514. (t "enclosed-expr"))))
  515. (when prefixed-expr
  516. (setcdr (car prefixed-expr) (list infix-token suffix-token)))
  517. (ess-node (cons type nil)
  518. (cons (ess-parser-token-start suffix-token) (point))
  519. (if prefixed-expr
  520. (list prefixed-expr args left)
  521. (list args left)))))
  522. ;;;*;;; Parsing
  523. (defun ess-parser-advance (&optional type value)
  524. (if (bound-and-true-p ess-parser--backward)
  525. (ess-climb-token type value)
  526. (ess-jump-token type value)))
  527. (defun ess-parser-advance-pair (&optional type token)
  528. (if (bound-and-true-p ess-parser--backward)
  529. (ess-climb-paired-delims type token)
  530. (ess-jump-paired-delims type token)))
  531. (defun ess-parser-next-token ()
  532. (if (bound-and-true-p ess-parser--backward)
  533. (ess-token-before)
  534. (ess-token-after)))
  535. (defun ess-parser-token-start (token)
  536. (if (bound-and-true-p ess-parser--backward)
  537. (ess-token-end token)
  538. (ess-token-start token)))
  539. (defun ess-parser-power (token)
  540. (or (if (bound-and-true-p ess-parser--backward)
  541. (gethash (ess-token-type token) ess-token-r-right-power-table)
  542. (gethash (ess-token-type token) ess-token-r-power-table))
  543. 0))
  544. (defun ess-node (type pos contents)
  545. (let ((pos (if (bound-and-true-p ess-parser--backward)
  546. (cons (cdr pos) (car pos))
  547. pos))
  548. (contents (if (bound-and-true-p ess-parser--backward)
  549. (nreverse contents)
  550. contents)))
  551. (list type pos contents)))
  552. (defalias 'ess-node-start #'ess-token-start)
  553. (defalias 'ess-node-end #'ess-token-end)
  554. (defun ess-parse-start-token (token)
  555. (let* ((table (if (bound-and-true-p ess-parser--backward)
  556. ess-token-r-rnud-table
  557. ess-token-r-nud-table))
  558. (nud (gethash (ess-token-type token) table)))
  559. (when (fboundp nud)
  560. (funcall nud token))))
  561. (defun ess-parse-infix-token (infix-token left)
  562. (let ((infix-power (ess-parser-power infix-token))
  563. (led (or (when (bound-and-true-p ess-parser--backward)
  564. (gethash (ess-token-type infix-token) ess-token-r-rid-table))
  565. (gethash (ess-token-type infix-token) ess-token-r-led-table))))
  566. (funcall led left infix-token)))
  567. (defun ess-parse-expression (&optional power)
  568. (let ((current (ess-parse-start-token (ess-parser-advance)))
  569. (power (or power 0))
  570. (next (ess-parser-next-token))
  571. (last-sucessful-pos (point))
  572. last-success)
  573. (setq last-success current)
  574. (while (and current (< power (ess-parser-power next)))
  575. (ess-parser-advance)
  576. (when (setq current (ess-parse-infix-token next current))
  577. (setq last-sucessful-pos (point))
  578. (setq last-success current))
  579. (setq next (ess-parser-next-token)))
  580. (goto-char last-sucessful-pos)
  581. last-success))
  582. (defun ess-parse-arglist (power start-token)
  583. (let ((start-pos (point))
  584. (arg-start-pos (point))
  585. (arglist (list start-token))
  586. (closing-delim (ess-token-balancing-delim start-token))
  587. expr)
  588. (while (and (setq expr (ess-parse-expression))
  589. (push (ess-node (cons "arg" nil)
  590. (cons arg-start-pos (point))
  591. (list expr))
  592. arglist)
  593. (ess-parser-advance ","))
  594. (setq arg-start-pos (point)))
  595. (push (ess-parser-advance closing-delim) arglist)
  596. (ess-node (cons "arglist" nil)
  597. (cons start-pos (1- (point)))
  598. (nreverse arglist))))
  599. (defun forward-ess-r-expr ()
  600. (interactive)
  601. (ess-save-excursion-when-nil
  602. (ess-escape-token)
  603. (ess-parse-expression)))
  604. (defun forward-ess-r-sexp ()
  605. (interactive)
  606. (ess-save-excursion-when-nil
  607. (ess-escape-token)
  608. (let* ((orig-token (ess-token-after))
  609. (tree (ess-parse-expression))
  610. (sexp-node (ess-parser-tree-assoc orig-token tree)))
  611. (when sexp-node
  612. (goto-char (ess-token-end sexp-node))
  613. sexp-node))))
  614. (defun backward-ess-r-expr ()
  615. (interactive)
  616. (let ((ess-parser--backward t))
  617. (ess-parse-expression)))
  618. (defun backward-ess-r-sexp ()
  619. (interactive)
  620. (error "Todo"))
  621. (defun ess-parser-tree-assoc (key tree)
  622. (let ((next tree)
  623. stack last-node result)
  624. (while (and next (null result))
  625. (cond ((eq next 'node-end)
  626. (pop last-node))
  627. ((nth 2 next)
  628. (push 'node-end stack)
  629. (dolist (node (nth 2 next))
  630. (push node stack))
  631. (push next last-node))
  632. ((equal next key)
  633. (setq result (car last-node))))
  634. (setq next (pop stack)))
  635. result))
  636. ;;*;; Point predicates
  637. (defun ess-inside-call-p (&optional call)
  638. "Return non-nil if point is in a function or indexing call."
  639. (let ((containing-sexp (or (bound-and-true-p containing-sexp)
  640. (ess-containing-sexp-position))))
  641. (save-excursion
  642. (and (prog1 (ess-goto-char containing-sexp)
  643. (ess-climb-chained-delims))
  644. (save-excursion
  645. (forward-char)
  646. (ess-up-list))
  647. (or (ess-behind-call-opening-p "(")
  648. (looking-at "\\["))
  649. (ess-inside-call-name-p call)))))
  650. (defun ess-inside-continuation-p ()
  651. (unless (or (looking-at ",")
  652. (ess-behind-call-opening-p "[[(]"))
  653. (or (save-excursion
  654. (ess-jump-object)
  655. (and (not (ess-ahead-param-assign-p))
  656. (ess-behind-operator-p)))
  657. (save-excursion
  658. (ess-climb-object)
  659. (ess-climb-operator)
  660. (and (ess-behind-operator-p)
  661. (not (ess-ahead-param-assign-p)))))))
  662. (defun ess-inside-call-name-p (&optional call)
  663. (save-excursion
  664. (ess-climb-call-name call)))
  665. (defun ess-inside-prefixed-block-p (&optional call)
  666. "Return non-nil if point is in a prefixed block.
  667. Prefixed blocks refer to the blocks following function
  668. declarations, control flow statements, etc.
  669. If CALL is not nil, check if the prefix corresponds to CALL. If
  670. nil, return the prefix."
  671. (save-excursion
  672. (ess-escape-prefixed-block call)))
  673. ;;*;; Syntactic Travellers and Predicates
  674. ;;;*;;; Blanks, Characters, Comments and Delimiters
  675. (defun ess-skip-blanks-backward (&optional newlines)
  676. "Skip blanks and newlines backward, taking end-of-line comments into account."
  677. (ess-any ((ess-skip-blanks-backward-1))
  678. ((when newlines
  679. (ess-while (and (not (bobp))
  680. (= (point) (line-beginning-position)))
  681. (forward-line -1)
  682. (goto-char (ess-code-end-position))
  683. (ess-skip-blanks-backward-1))))))
  684. (defun ess-skip-blanks-backward-1 ()
  685. (and (not (bobp))
  686. (/= 0 (skip-syntax-backward " "))))
  687. (defun ess-skip-blanks-forward (&optional newlines)
  688. "Skip blanks and newlines forward, taking end-of-line comments into account."
  689. (ess-any ((/= 0 (skip-syntax-forward " ")))
  690. ((ess-while (and newlines
  691. (= (point) (ess-code-end-position))
  692. (when (ess-save-excursion-when-nil
  693. ;; Handles corner cases such as point being on last line
  694. (let ((orig-point (point)))
  695. (forward-line)
  696. (back-to-indentation)
  697. (> (point) orig-point)))
  698. (skip-chars-forward " \t")
  699. t))))))
  700. (defun ess-jump-char (char)
  701. (ess-save-excursion-when-nil
  702. (ess-skip-blanks-forward t)
  703. (when (looking-at char)
  704. (goto-char (match-end 0)))))
  705. (defun ess-escape-comment ()
  706. (when (ess-inside-comment-p)
  707. (prog1 (comment-beginning)
  708. (skip-chars-backward "#+[ \t]*"))))
  709. (defun ess-ahead-closing-p ()
  710. (memq (char-before) '(?\] ?\} ?\))))
  711. (defun ess-ahead-boundary-p ()
  712. (looking-back "[][ \t\n(){},]" (1- (point))))
  713. (defun ess-escape-string ()
  714. (and (nth 3 (syntax-ppss))
  715. (ess-goto-char (nth 8 (syntax-ppss)))))
  716. (defun ess-climb-paired-delims (&optional type token)
  717. (ess-save-excursion-when-nil
  718. (let ((token (or token (ess-token-before))))
  719. (goto-char (ess-token-end token))
  720. (when (if type
  721. (ess-token= token type)
  722. (ess-token-delimiter-p token))
  723. (and (ess-backward-sexp)
  724. (ess-token-after))))))
  725. (defun ess-jump-paired-delims (&optional type token)
  726. (ess-save-excursion-when-nil
  727. (let ((token (or token (ess-token-after))))
  728. (goto-char (ess-token-start token))
  729. (when (if type
  730. (ess-token= token type)
  731. (ess-token-delimiter-p token))
  732. (and (ess-forward-sexp)
  733. (ess-token-before))))))
  734. ;;;*;;; Blocks
  735. (defun ess-block-opening-p ()
  736. (save-excursion
  737. (cond
  738. ((looking-at "{"))
  739. ;; Opening parenthesis not attached to a function opens up a
  740. ;; block too. Only pick up those that are last on their line
  741. ((ess-behind-block-paren-p)))))
  742. (defun ess-block-closing-p ()
  743. (save-excursion
  744. (cond
  745. ((looking-at "}"))
  746. ((looking-at ")")
  747. (forward-char)
  748. (backward-sexp)
  749. (not (looking-back
  750. (concat ess-r-name-pattern "[[:blank:]]*")
  751. (line-beginning-position)))))))
  752. (defun ess-block-p ()
  753. (or (save-excursion
  754. (when containing-sexp
  755. (goto-char containing-sexp)
  756. (ess-block-opening-p)))
  757. (ess-unbraced-block-p)))
  758. ;; Parenthesised expressions
  759. (defun ess-behind-block-paren-p ()
  760. (and (looking-at "(")
  761. (not (ess-ahead-attached-name-p))))
  762. (defun ess-climb-block (&optional ignore-ifelse)
  763. (ess-save-excursion-when-nil
  764. (cond
  765. ((and (not ignore-ifelse)
  766. (ess-climb-if-else 'to-start)))
  767. ((and (eq (char-before) ?\})
  768. (prog2
  769. (forward-char -1)
  770. (ess-up-list -1)
  771. (ess-climb-block-prefix)))))))
  772. (defvar ess-prefixed-block-patterns
  773. (mapcar (lambda (fun) (concat fun "[ \t\n]*("))
  774. '("function" "if" "for" "while")))
  775. (defun ess-behind-prefixed-block-p (&optional call)
  776. (if call
  777. (looking-at (concat call "[ \t]*("))
  778. (cl-some 'looking-at ess-prefixed-block-patterns)))
  779. (defun ess-unbraced-block-p (&optional ignore-ifelse)
  780. "This indicates whether point is in front of an unbraced
  781. prefixed block following a control flow statement. Returns
  782. position of the control flow function (if, for, while, etc)."
  783. (save-excursion
  784. (and (ess-backward-sexp)
  785. (or (and (looking-at "else\\b")
  786. (not ignore-ifelse))
  787. (and (looking-at "(")
  788. (ess-backward-sexp)
  789. (cl-some 'looking-at ess-prefixed-block-patterns)
  790. (if ignore-ifelse
  791. (not (looking-at "if\\b"))
  792. t)))
  793. (point))))
  794. (defun ess-climb-block-prefix (&optional call ignore-ifelse)
  795. "Climb the prefix of a prefixed block.
  796. Prefixed blocks refer to the blocks following function
  797. declarations, control flow statements, etc.
  798. Should be called either in front of a naked block or in front
  799. of the curly brackets of a braced block.
  800. If CALL not nil, check if the prefix corresponds to CALL. If nil,
  801. return the prefix."
  802. (ess-save-excursion-when-nil
  803. (or (and (not ignore-ifelse)
  804. (prog1 (and (ess-climb-if-else-call)
  805. (or (null call)
  806. (looking-at call)))
  807. (when (ess-token-after= "else")
  808. (ess-climb-token "}"))))
  809. (let ((pos (ess-unbraced-block-p ignore-ifelse)))
  810. (and (ess-goto-char pos)
  811. (if call
  812. (looking-at call)
  813. (cond ((looking-at "function")
  814. "function")
  815. ((looking-at "for")
  816. "for")
  817. ((looking-at "if")
  818. "if")
  819. ((looking-at "else")
  820. "else"))))))))
  821. (defun ess-escape-prefixed-block (&optional call)
  822. "Climb outside of a prefixed block."
  823. (let ((containing-sexp (or (bound-and-true-p containing-sexp)
  824. (ess-containing-sexp-position))))
  825. (or (ess-save-excursion-when-nil
  826. (and (ess-goto-char containing-sexp)
  827. (looking-at "{")
  828. (ess-climb-block-prefix call)))
  829. (ess-escape-unbraced-block call))))
  830. (defun ess-escape-unbraced-block (&optional call)
  831. (ess-save-excursion-when-nil
  832. (while (and (not (ess-unbraced-block-p))
  833. (or (ess-escape-continuations)
  834. (ess-escape-call))))
  835. (ess-climb-block-prefix call)))
  836. (defun ess-jump-block ()
  837. (cond
  838. ;; if-else blocks
  839. ((ess-jump-if-else))
  840. ;; Prefixed blocks such as `function() {}'
  841. ((ess-behind-prefixed-block-p)
  842. (ess-jump-prefixed-block))
  843. ;; Naked blocks
  844. ((and (or (looking-at "{")
  845. (ess-behind-block-paren-p))
  846. (ess-forward-sexp)))))
  847. (defun ess-jump-prefixed-block (&optional call)
  848. (ess-save-excursion-when-nil
  849. (when (ess-behind-prefixed-block-p call)
  850. (ess-forward-sexp 2)
  851. (ess-skip-blanks-forward t)
  852. (if (looking-at "{")
  853. (ess-forward-sexp)
  854. (prog1 (ess-jump-expression)
  855. (ess-jump-continuations))))))
  856. ;;;*;;; Calls
  857. (defun ess-call-closing-p ()
  858. (save-excursion
  859. (when (cond ((looking-at ")")
  860. (ess-up-list -1))
  861. ((looking-at "]")
  862. (when (ess-up-list -1)
  863. (prog1 t (ess-climb-chained-delims)))))
  864. (ess-ahead-attached-name-p))))
  865. (defun ess-behind-call-opening-p (pattern)
  866. (and (looking-at pattern)
  867. (ess-ahead-attached-name-p)))
  868. ;; Should be called just before the opening brace
  869. (defun ess-ahead-attached-name-p ()
  870. (save-excursion
  871. (ess-climb-object)))
  872. (defun ess-ahead-param-assign-p ()
  873. "Return non-nil if looking at a function argument.
  874. To be called just before the `=' sign."
  875. (ess-refined-token= (ess-token-before) "param-assign"))
  876. (defun ess-behind-arg-p ()
  877. (save-excursion
  878. (ess-jump-arg)))
  879. (defun ess-behind-parameter-p ()
  880. (save-excursion
  881. (ess-jump-parameter)))
  882. (defun ess-jump-parameter ()
  883. (ess-save-excursion-when-nil
  884. (and (ess-jump-name)
  885. (when (looking-at "[ \t]*=\\([^=]\\)")
  886. (goto-char (match-beginning 1))
  887. (ess-skip-blanks-forward)
  888. t))))
  889. (defun ess-jump-arg ()
  890. (ess-save-excursion-when-nil
  891. (ess-skip-blanks-forward t)
  892. (ess-any ((ess-jump-parameter))
  893. ((ess-jump-expression))
  894. ((ess-jump-continuations)))))
  895. (defun ess-arg-bounds ()
  896. "Should be called in front of the argument."
  897. (save-excursion
  898. (let ((beg (point)))
  899. (and (ess-jump-arg)
  900. (list beg (point))))))
  901. (defun ess-climb-call (&optional call)
  902. "Climb functions (e.g. ggplot) and parenthesised expressions."
  903. (or (ess-while (ess-save-excursion-when-nil
  904. (ess-climb-name)
  905. (and (ess-climb-chained-delims ?\])
  906. ;; (ess-climb-expression)
  907. (if (eq (char-before) ?\))
  908. (ess-climb-call)
  909. (ess-climb-name))
  910. )))
  911. (ess-save-excursion-when-nil
  912. (when (and (memq (char-before) '(?\] ?\) ?\}))
  913. (ess-backward-sexp))
  914. (if call
  915. (and (ess-climb-name)
  916. (looking-at call)))
  917. (prog1 t
  918. (ess-climb-name))))))
  919. (defun ess-climb-call-name (&optional call)
  920. (ess-save-excursion-when-nil
  921. (ess-jump-name)
  922. (ess-skip-blanks-forward)
  923. (and (ess-behind-call-opening-p "[[(]")
  924. (ess-climb-name)
  925. (or (null call)
  926. (looking-at call)))))
  927. (defun ess-step-to-first-arg ()
  928. (let ((containing-sexp (ess-containing-sexp-position)))
  929. (cond ((ess-inside-call-p)
  930. (goto-char containing-sexp)
  931. (forward-char)
  932. t)
  933. ((ess-inside-call-name-p)
  934. (ess-jump-name)
  935. (ess-skip-blanks-forward)
  936. (forward-char)
  937. t))))
  938. (defun ess-jump-to-next-arg ()
  939. (and (ess-jump-arg)
  940. (prog1 (ess-jump-char ",")
  941. (ess-skip-blanks-forward t))))
  942. (defun ess-jump-call ()
  943. (ess-save-excursion-when-nil
  944. (or (and (ess-jump-object)
  945. (cond ((eq (char-before) ?\)))
  946. ((looking-at "\\[")
  947. (ess-jump-chained-brackets))
  948. ((looking-at "(")
  949. (ess-forward-sexp))))
  950. (and (looking-at "[ \t]*(")
  951. (ess-forward-sexp)))))
  952. (defun ess-behind-call-p ()
  953. (save-excursion
  954. (ess-jump-object)
  955. (ess-skip-blanks-forward)
  956. (looking-at "[[(]")))
  957. (defun ess-climb-chained-delims (&optional delim)
  958. "Should be called with point between delims, e.g. `]|['."
  959. (setq delim (if delim
  960. (list delim)
  961. '(?\] ?\))))
  962. (ess-while (ess-save-excursion-when-nil
  963. (when (memq (char-before) delim)
  964. (ess-backward-sexp)))))
  965. (defun ess-jump-chained-brackets ()
  966. (ess-while (ess-save-excursion-when-nil
  967. (when (eq (char-after) ?\[)
  968. (ess-forward-sexp)))))
  969. (defun ess-escape-call (&optional call)
  970. (let ((containing-sexp (ess-containing-sexp-position)))
  971. (if (ess-inside-call-p)
  972. (ess-save-excursion-when-nil
  973. (goto-char containing-sexp)
  974. (ess-climb-chained-delims)
  975. (and (ess-climb-name)
  976. (or (null call)
  977. (looking-at call))))
  978. ;; At top level or inside a block, check if point is on the
  979. ;; function name.
  980. (ess-save-excursion-when-nil
  981. (let ((orig-pos (point)))
  982. (and (ess-jump-name)
  983. (looking-at "[[(]")
  984. (ess-climb-name)
  985. (or (null call)
  986. (looking-at call))
  987. (/= (point) orig-pos)))))))
  988. (defun ess-escape-calls ()
  989. (ess-while (ess-escape-call)))
  990. (defun ess-jump-inside-call ()
  991. (ess-save-excursion-when-nil
  992. (when (ess-jump-name)
  993. (ess-skip-blanks-forward)
  994. (when (looking-at "(")
  995. (forward-char)
  996. t))))
  997. (defun ess-args-bounds (&optional marker)
  998. (let ((containing-sexp (ess-containing-sexp-position)))
  999. (when (ess-inside-call-p)
  1000. (save-excursion
  1001. (let ((beg (1+ containing-sexp))
  1002. (call-beg (ess-at-containing-sexp
  1003. (ess-climb-name)
  1004. (point))))
  1005. ;; (ess-up-list) can't find its way when point is on a
  1006. ;; backquoted name, so start from `beg'.
  1007. (and (goto-char beg)
  1008. (ess-up-list)
  1009. (prog1 t
  1010. (forward-char -1))
  1011. (let ((end (if marker
  1012. (point-marker)
  1013. (point))))
  1014. (list beg end call-beg))))))))
  1015. (defun ess-args-alist ()
  1016. "Return all arguments as an alist with cars set to argument
  1017. names and cdrs set to the expressions given as argument. Both
  1018. cars and cdrs are returned as strings."
  1019. (save-excursion
  1020. (when (ess-step-to-first-arg)
  1021. (let (args current-arg)
  1022. (while (and (setq current-arg (ess-cons-arg))
  1023. (setq args (nconc args (list current-arg)))
  1024. (ess-jump-to-next-arg)))
  1025. args))))
  1026. (defun ess-cons-arg ()
  1027. "Return a cons cell of the current argument with car set to the
  1028. parameter name (nil if not specified) and cdr set to the argument
  1029. expression."
  1030. (save-excursion
  1031. (ess-skip-blanks-forward t)
  1032. (let ((param (when (ess-behind-parameter-p)
  1033. (buffer-substring-no-properties
  1034. (point)
  1035. (prog2
  1036. (ess-jump-name)
  1037. (point)
  1038. (ess-jump-char "=")
  1039. (ess-skip-blanks-forward)))))
  1040. (arg (buffer-substring-no-properties
  1041. (point)
  1042. (progn
  1043. (ess-jump-arg)
  1044. (point)))))
  1045. (cons param arg))))
  1046. ;;;*;;; Statements
  1047. (defun ess-behind-operator-p (&optional strict)
  1048. (ess-token-operator-p (ess-token-after) strict))
  1049. (defun ess-ahead-operator-p (&optional strict)
  1050. (ess-token-operator-p (ess-token-before) strict))
  1051. (defun ess-climb-lhs (&optional no-fun-arg climb-line)
  1052. (ess-save-excursion-when-nil
  1053. (let ((start-line (line-number-at-pos)))
  1054. (ess-climb-operator)
  1055. (when (and (or climb-line (equal (line-number-at-pos) start-line))
  1056. (ess-behind-definition-op-p no-fun-arg))
  1057. (prog1 t
  1058. (ess-climb-expression))))))
  1059. (defun ess-jump-lhs ()
  1060. (ess-save-excursion-when-nil
  1061. (and (ess-jump-name)
  1062. (ess-behind-definition-op-p)
  1063. (ess-jump-operator))))
  1064. (defun ess-climb-operator ()
  1065. (when (ess-token-operator-p (ess-token-before))
  1066. (prog1 (ess-climb-token)
  1067. (ess-skip-blanks-backward))))
  1068. ;; Currently doesn't check that the operator is not binary
  1069. (defun ess-climb-unary-operator ()
  1070. (ess-save-excursion-when-nil
  1071. (let ((token (ess-climb-token)))
  1072. (member (ess-token-type token) '("+" "-" "!" "?" "~")))))
  1073. ;; Currently returns t if we climbed lines, nil otherwise.
  1074. (defun ess-climb-continuations (&optional cascade ignore-ifelse)
  1075. (let* ((start-line (line-number-at-pos))
  1076. (state (list :start-line start-line
  1077. :last-line start-line
  1078. :moved 0
  1079. :last-pos (point)
  1080. :prev-point nil
  1081. :def-op nil
  1082. :expr nil)))
  1083. (when (ess-while (and (<= (plist-get state :moved) 1)
  1084. (or (ess-save-excursion-when-nil
  1085. (and (ess-climb-operator)
  1086. (ess-climb-continuations--update-state state cascade 'op)
  1087. (ess-climb-expression ignore-ifelse)))
  1088. (ess-climb-unary-operator))
  1089. (/= (plist-get state :last-pos) (point)))
  1090. (ess-climb-continuations--update-state state cascade nil)
  1091. (plist-put state :last-pos (point)))
  1092. (when (and (plist-get state :prev-point)
  1093. (or (= (plist-get state :moved) 3)
  1094. (not (plist-get state :expr))))
  1095. (goto-char (plist-get state :prev-point)))
  1096. (if (plist-get state :def-op)
  1097. 'def-op
  1098. (< (line-number-at-pos) (plist-get state :start-line))))))
  1099. (defun ess-climb-continuations--update-state (state cascade &optional op)
  1100. ;; Climbing multi-line expressions should not count as moving up
  1101. (when op
  1102. (plist-put state :expr (ess-ahead-closing-p)))
  1103. (let ((cur-line (line-number-at-pos)))
  1104. (when (and (plist-get state :last-line)
  1105. (< cur-line (plist-get state :last-line))
  1106. (or cascade (not (plist-get state :expr))))
  1107. (plist-put state :moved (1+ (plist-get state :moved)))
  1108. (plist-put state :last-line cur-line)))
  1109. ;; Don't update counter after climbing operator or climbing too high
  1110. (when (and (not op)
  1111. (<= (plist-get state :moved) 1))
  1112. (plist-put state :prev-point (point)))
  1113. (when (and (ess-behind-definition-op-p)
  1114. (<= (plist-get state :moved) 1))
  1115. (plist-put state :def-op t))
  1116. t)
  1117. (defun ess-jump-operator ()
  1118. (when (ess-behind-operator-p)
  1119. (ess-jump-token)
  1120. (ess-skip-blanks-forward t)
  1121. t))
  1122. (defun ess-jump-continuation ()
  1123. (and (ess-jump-operator)
  1124. (ess-jump-expression)))
  1125. (defun ess-jump-continuations ()
  1126. (let (last-pos)
  1127. (when (ess-while (and (or (null last-pos)
  1128. (/= (point) last-pos))
  1129. (setq last-pos (point))
  1130. (ess-jump-continuation)))
  1131. ;; In calls, operators can start on newlines
  1132. (let ((start-line (line-number-at-pos)))
  1133. (when (ess-save-excursion-when-nil
  1134. (and (ess-inside-call-p)
  1135. (ess-skip-blanks-forward t)
  1136. (/= (line-number-at-pos) start-line)
  1137. (ess-behind-operator-p)))
  1138. (ess-jump-continuations)))
  1139. t)))
  1140. (defun ess-ahead-continuation-p (&optional or-parameter)
  1141. (or (ess-token-operator-p (ess-token-before) (not or-parameter))
  1142. (save-excursion
  1143. (ess-climb-block-prefix))
  1144. (ess-token-after= "else")
  1145. (save-excursion
  1146. (ess-climb-if-else-call))))
  1147. (defun ess-token-definition-op-p (token strict)
  1148. (and (ess-token= token '("<-" "<<-" ":=" "~" "="))
  1149. (if strict
  1150. (not (ess-refined-token= token "param-assign"))
  1151. t)))
  1152. (defun ess-behind-definition-op-p (&optional strict)
  1153. (ess-token-definition-op-p (ess-token-after) strict))
  1154. (defun ess-ahead-definition-op-p (&optional strict)
  1155. (ess-token-definition-op-p (ess-token-before) strict))
  1156. (defun ess-behind-assignment-op-p ()
  1157. (let ((token (ess-token-after)))
  1158. (and (ess-token= token '("<-" "="))
  1159. (not (ess-refined-token= token "param-assign")))))
  1160. (defun ess-escape-continuations ()
  1161. (ess-any ((unless (ess-ahead-boundary-p)
  1162. (ess-climb-expression)))
  1163. ((ess-while (ess-climb-continuations)))))
  1164. (defun ess-continuations-bounds (&optional marker)
  1165. (save-excursion
  1166. (let ((beg (progn
  1167. (ess-escape-continuations)
  1168. (point))))
  1169. (when beg
  1170. (ess-jump-expression)
  1171. (ess-jump-continuations)
  1172. (let ((end (if marker
  1173. (point-marker)
  1174. (point))))
  1175. (list beg end))))))
  1176. (defun ess-climb-to-top-level ()
  1177. (while (ess-goto-char (ess-containing-sexp-position)))
  1178. (ess-escape-continuations))
  1179. ;;;*;;; Statements: Control Flow
  1180. (defun ess-climb-if-else-call (&optional multi-line)
  1181. "Climb if, else, and if else calls."
  1182. (ess-save-excursion-when-nil
  1183. (cond ((ess-climb-paired-delims ")")
  1184. (when (ess-climb-token "if")
  1185. ;; Check for `else if'
  1186. (prog1 t
  1187. (ess-save-excursion-when-nil
  1188. (let ((orig-line (line-number-at-pos)))
  1189. (and (ess-climb-token "else")
  1190. (or multi-line
  1191. (eq orig-line (line-number-at-pos)))))))))
  1192. ((ess-climb-token "else")))))
  1193. (defun ess-climb-if-else-body (&optional from-else)
  1194. (cond
  1195. ;; Climb braced body
  1196. ((ess-save-excursion-when-nil
  1197. (and (when (progn (ess-skip-blanks-backward t)
  1198. (eq (char-before) ?\}))
  1199. (prog1 t (forward-char -1)))
  1200. (ess-up-list -1))))
  1201. ;; Climb unbraced body
  1202. ((when from-else
  1203. (ess-save-excursion-when-nil
  1204. (ess-skip-blanks-backward t)
  1205. (prog1 (ess-climb-expression 'ignore-ifelse)
  1206. (or (ess-climb-continuations nil 'ignore-ifelse)
  1207. (ess-climb-block-prefix nil 'ignore-ifelse))))))))
  1208. (defun ess-climb-if-else (&optional to-start)
  1209. "Climb horizontal as well as vertical if-else chains, with or
  1210. without curly braces."
  1211. ;; Don't climb if we're atop the current chain of if-else
  1212. (unless (ess-token-after= "if")
  1213. (ess-save-excursion-when-nil
  1214. (let ((from-else (ess-token-after= "else")))
  1215. (when (and (ess-climb-if-else-body from-else)
  1216. (ess-climb-if-else-call to-start))
  1217. ;; If we start from a final else and climb to another else, we
  1218. ;; are in the wrong chain of if-else. In that case,
  1219. ;; climb-recurse to the top of the current chain and climb
  1220. ;; again to step in the outer chain.
  1221. (when (save-excursion (and from-else
  1222. (ess-jump-token "else")
  1223. (not (ess-jump-token "if"))))
  1224. (ess-climb-if-else 'to-start)
  1225. (ess-climb-continuations)
  1226. (ess-climb-block-prefix nil 'ignore-ifelse)
  1227. (ess-climb-if-else-call nil))
  1228. (ess-maybe-climb-broken-else)
  1229. (when to-start
  1230. (ess-climb-if-else to-start))
  1231. t)))))
  1232. ;; Broken else: if \n else
  1233. (defun ess-maybe-climb-broken-else (&optional same-line)
  1234. (ess-save-excursion-when-nil
  1235. ;; Don't record current line if not needed (expensive operation)
  1236. (let ((cur-line (when same-line (line-number-at-pos))))
  1237. (and (ess-climb-token "else")
  1238. (if same-line
  1239. (= cur-line (line-number-at-pos))
  1240. t)))))
  1241. (defun ess-skip-curly-backward ()
  1242. (re-search-backward "}[ \t]*" (line-beginning-position) t))
  1243. (defun ess-jump-if-else ()
  1244. (let (from)
  1245. (ess-while (ess-save-excursion-when-nil
  1246. (ess-skip-blanks-forward t)
  1247. (cond
  1248. ((and (not (eq from 'if))
  1249. (ess-jump-if)
  1250. (setq from 'if)))
  1251. ((looking-at "else")
  1252. (ess-forward-sexp)
  1253. (or (ess-jump-if)
  1254. (progn
  1255. (ess-skip-blanks-forward t)
  1256. (ess-jump-expression)))
  1257. (setq from 'else))
  1258. (t
  1259. nil))))))
  1260. (defun ess-jump-if ()
  1261. (ess-save-excursion-when-nil
  1262. (ess-skip-blanks-forward t)
  1263. (and (looking-at "if[ \t\n]*(")
  1264. (ess-forward-sexp 2)
  1265. (progn
  1266. (ess-skip-blanks-forward t)
  1267. (ess-jump-expression)))))
  1268. ;;;*;;; Function Declarations
  1269. (defun ess-behind-defun-p ()
  1270. (or (looking-at "function[ \t]*(")
  1271. (ess-behind-enclosed-defun-p)))
  1272. (defun ess-behind-enclosed-defun-p ()
  1273. (save-excursion
  1274. (and (ess-behind-call-p)
  1275. (ess-jump-inside-call)
  1276. (cl-some (lambda (arg)
  1277. (string-match "^function\\b"
  1278. (cdr arg)))
  1279. (ess-args-alist)))))
  1280. ;;;*;;; Names / Objects / Expressions
  1281. ;; Should climb any names, including backquoted ones or those
  1282. ;; containing `@' or `$'. Difficult to achieve with regexps, but
  1283. ;; skipping chars is faster anyway.
  1284. (defun ess-climb-object ()
  1285. (ess-save-excursion-when-nil
  1286. (let (climbed)
  1287. (ess-skip-blanks-backward)
  1288. ;; Backquoted names can contain any character
  1289. (if (and (memq (char-before) '(?` ?\" ?\'))
  1290. (ess-backward-sexp))
  1291. (setq climbed t)
  1292. (while (cl-some (apply-partially '/= 0)
  1293. `(,(skip-syntax-backward "w_")
  1294. ,(skip-chars-backward "\"'")))
  1295. (setq climbed t)))
  1296. ;; Recurse if we find an indexing char
  1297. (let ((tok (ess-token-before)))
  1298. (when (member (ess-token-type tok) '("$" "@" "::" ":::"))
  1299. (goto-char (ess-token-start tok))
  1300. (ess-climb-object)))
  1301. climbed)))
  1302. ;; Todo: split name and object climbing
  1303. (defun ess-climb-name ()
  1304. (ess-climb-object))
  1305. ;; This jumps both object names and atomic objects like strings or
  1306. ;; numbers.
  1307. (defun ess-jump-object ()
  1308. (cond
  1309. ;; Jump over object names
  1310. ((ess-jump-name))
  1311. ;; Jump over strings))
  1312. ((ess-save-excursion-when-nil
  1313. (skip-chars-forward " \t")
  1314. (memq (char-after) '(?\" ?\')))
  1315. (ess-forward-sexp))))
  1316. (defun ess-jump-name ()
  1317. (ess-save-excursion-when-nil
  1318. (let (climbed)
  1319. (skip-chars-forward " \t")
  1320. ;; Jump over backquoted names
  1321. (cond ((and (eq (char-after) ?`)
  1322. (looking-back ess-r-symbol-pattern
  1323. (1- (point))))
  1324. (forward-char)
  1325. (setq climbed t))
  1326. ((eq (char-after) ?`)
  1327. (forward-char)
  1328. (when (ess-while (not (memq (char-after) '(?` ?\C-J)))
  1329. (forward-char))
  1330. (setq climbed t)
  1331. (forward-char)))
  1332. ;; Jump over regular names
  1333. ((when (/= 0 (skip-syntax-forward "w_"))
  1334. ;; Maybe point was inside backticks
  1335. (when (eq (char-after) ?`)
  1336. (forward-char))
  1337. (setq climbed t))))
  1338. climbed)))
  1339. (defun ess-climb-expression (&optional ignore-ifelse)
  1340. (ess-save-excursion-when-nil
  1341. (or (ess-climb-block ignore-ifelse)
  1342. (ess-climb-call)
  1343. (ess-climb-object))))
  1344. (defun ess-jump-expression ()
  1345. (or (ess-jump-block)
  1346. (ess-jump-call)
  1347. (ess-jump-object)))
  1348. (provide 'ess-r-syntax)
  1349. ;;; ess-r-syntax.el ends here