File: ess-utils.el

package info (click to toggle)
ess 16.10-1
  • links: PTS
  • area: main
  • in suites: stretch
  • size: 7,260 kB
  • ctags: 2,341
  • sloc: lisp: 27,692; sh: 1,579; asm: 848; makefile: 368
file content (1294 lines) | stat: -rw-r--r-- 55,164 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
;;; ess-utils.el --- General Emacs utility functions used by ESS

;; Copyright (C) 1998--2010 A.J. Rossini, Richard M. Heiberger, Martin
;;      Maechler, Kurt Hornik, Rodney Sparapani, and Stephen Eglen.
;; Copyright (C) 2011--2012 A.J. Rossini, Richard M. Heiberger, Martin Maechler,
;;      Kurt Hornik, Rodney Sparapani, Stephen Eglen and Vitalie Spinu.

;; Author: Martin Maechler <maechler@stat.math.ethz.ch>
;; Created: 9 Sept 1998
;; Maintainer: ESS-core <ESS-core@r-project.org>

;; This file is part of ESS (Emacs Speaks Statistics).

;; 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/

;;; Code:

(eval-when-compile
  (require 'tramp)
  (require 'cl))

(defun ess-inside-string-or-comment-p (&optional pos)
  "Return non-nil if POSition [defaults to (point)] is inside string or comment
 (according to syntax)."
  ;;FIXME (defun ess-calculate-indent ..)  can do that ...
  (interactive)
  (setq pos (or pos (point)))
  (let ((ppss (syntax-ppss pos)))
    (or (car (setq ppss (nthcdr 3 ppss)))
        (car (setq ppss (cdr ppss)))
        (nth 3 ppss))))


(defun ess-inside-string-p (&optional pos)
  "Return non-nil if point is inside string (according to syntax)."
  (interactive)
  ;; when narrowing the buffer in iESS the ppss cahce is screwed:( But it is
  ;; very fast, so don't bother for now.
  (let ((pps (syntax-ppss pos)))
    (nth 3 pps))
  ;; (nth 3 (parse-partial-sexp (point-min) pos))
  )

(defun ess-inside-comment-p (&optional pos)
  "Return non-nil if point is inside string (according to syntax)."
  (interactive)
  (setq pos (or pos (point)))
  (save-excursion
    (or (when font-lock-mode ;; this is a shortcut (works well usually)
	  (let ((face (get-char-property pos 'face)))
	    (eq 'font-lock-comment-face face)))
	(nth 4 (parse-partial-sexp (progn (goto-char pos) (point-at-bol)) pos)))))

(defun ess-inside-brackets-p (&optional pos curly?)
  "Return t if position POS is inside brackets.
POS defaults to point if no value is given. If curly? is non nil
also return t if inside curly brackets."
  (save-excursion
    (let ((ppss (syntax-ppss pos))
          (r nil))
      (while (and (> (nth 0 ppss) 0)
                  (not r))
        (goto-char (nth 1 ppss))
        (when (or (char-equal ?\[ (char-after))
                  (and curly?
                       (char-equal ?\{ (char-after))))
          (setq r t))
        (setq ppss (syntax-ppss)))
      r)))

(defun ess--extract-default-fl-keywords (keywords)
  "Extract the t-keywords from `ess-font-lock-keywords'."
  (delq nil (mapcar (lambda (c)
                      (when (cdr c) (symbol-value (car c))))
                    (if (symbolp keywords)
                        (symbol-value keywords)
                      keywords))))

(defun ess-font-lock-toggle-keyword (keyword)
  (interactive
   (list (intern (ess-completing-read
                  "Keyword to toggle"
                  (mapcar (lambda (el) (symbol-name (car el)))
                          (symbol-value ess-font-lock-keywords))
                  nil t))))
  (let* ((kwds (symbol-value (if (eq major-mode 'ess-mode)
                                 ess-font-lock-keywords
                               inferior-ess-font-lock-keywords)))
         (kwd (assoc keyword kwds)))
    (unless kwd (error "Keyword %s was not found in (inferior-)ess-font-lock-keywords list" keyword))
    (if (cdr kwd)
        (setcdr kwd nil)
      (setcdr kwd t))
    (let ((mode major-mode)
          (dialect ess-dialect)
          (fld (ess--extract-default-fl-keywords kwds)))
      ;; refresh font-lock defaults in all necessary buffers
      (mapc (lambda (b)
              (with-current-buffer b
                (when (and (eq major-mode mode)
                           (eq ess-dialect dialect))
                  (setcar font-lock-defaults fld)
                  (font-lock-refresh-defaults))))
            (buffer-list)))))


(defun ess--generate-font-lock-submenu (menu)
  "Internal, used to generate ESS font-lock submenu"
  (append (mapcar (lambda (el)
                    `[,(symbol-name (car el))
                      (lambda () (interactive)
                        (ess-font-lock-toggle-keyword ',(car el)))
                      :style toggle
                      :enable t
                      :selected ,(cdr el)])
                  (cond ((eq major-mode 'ess-mode)
                         (symbol-value ess-font-lock-keywords))
                        ((eq major-mode 'inferior-ess-mode)
                         (symbol-value inferior-ess-font-lock-keywords))))
          (list "-----"
                ["Save to custom" (lambda () (interactive)
                                    (let ((kwd (if (eq major-mode 'ess-mode)
                                                   ess-font-lock-keywords
                                                 inferior-ess-font-lock-keywords)))
                                      (customize-save-variable kwd (symbol-value kwd)))) t])))



(defun ess--generate-eval-visibly-submenu (menu)
  '(["yes" (lambda () (interactive) (setq ess-eval-visibly t))
     :style radio :enable t :selected (eq ess-eval-visibly t)]
    ["nowait" (lambda () (interactive) (setq ess-eval-visibly 'nowait))
     :style radio :enable t :selected (eq ess-eval-visibly 'nowait) ]
    ["no" (lambda () (interactive) (setq ess-eval-visibly nil))
     :style radio :enable t :selected (eq ess-eval-visibly nil) ]))


(defun ess-quote-special-chars (string)
  (replace-regexp-in-string
   "\"" "\\\\\\&"
   (replace-regexp-in-string ;; replace backslashes
    "\\\\" "\\\\" string nil t)))

;; simple alternative to ess-read-object-name-default of ./ess-inf.el :
;; is "wrongly" returning   "p1"  for word "p1.part2" :
(defun ess-extract-word-name ()
  "Get the word you're on (cheap algorithm). Use `ess-read-object-name-default'
for a better but slower version."
  (save-excursion
    (re-search-forward "\\<\\w+\\>" nil t)
    (buffer-substring (match-beginning 0) (match-end 0))))

(defun ess-rep-regexp (regexp to-string &optional fixedcase literal verbose)
  "Instead of (replace-regexp..) -- do NOT replace in strings or comments.
 If FIXEDCASE is non-nil, do *not* alter case of replacement text.
 If LITERAL   is non-nil, do *not* treat `\\' as special.
 If VERBOSE   is non-nil, (message ..) about replacements."
  (let ((case-fold-search (and case-fold-search
                               (not fixedcase))); t  <==> ignore case in search
        (ppt (point)); previous point
        (p))
    (while (and (setq p (re-search-forward regexp nil t))
                (< ppt p))
      (setq ppt p)
      (cond ((not (ess-inside-string-or-comment-p (1- p)))
             (if verbose
                 (let ((beg (match-beginning 0)))
                   (message "buffer in (match-beg.,p)=(%d,%d) is '%s'"
                            beg p (buffer-substring beg p))))
             (replace-match to-string fixedcase literal)
             ;;or (if verbose (setq pl (append pl (list p))))
             )))
    ;;or (if (and verbose pl)
    ;;or  (message "s/%s/%s/ at %s" regexp to-string pl))
    ) )

(defun ess-replace-regexp-dump-to-src
  (regexp to-string &optional dont-query verbose ensure-mode)
  "Depending on dont-query, call `ess-rep-regexp' or `query-replace-regexp'
from the beginning of the buffer."
  (save-excursion
    (if (and ensure-mode
             (not (equal major-mode 'ess-mode)))
        (ess-mode))
    (goto-char (point-min))
    (if dont-query
        (ess-rep-regexp     regexp to-string nil nil verbose)
      (query-replace-regexp regexp to-string nil))))


(defun ess-revert-wisely ()
  "Revert from disk if file and buffer last modification times are different."
  (interactive)

                                        ; whether or not a revert is needed, force load local variables
                                        ; for example, suppose that you change the local variables and then
                                        ; save the file, a revert is unneeded, but a force load is
  (hack-local-variables)

  (if (not (verify-visited-file-modtime (current-buffer))) (progn
                                                             (let ((ess-temp-store-point (point)))
                                                               (revert-buffer t t)
                                                               (goto-char ess-temp-store-point))
                                                             t)
    nil))


(defun ess-space-around (word &optional from verbose)
  "Replace-regexp .. ensuring space around all occurences of WORD,
 starting from FROM {defaults to (point)}."
  (interactive "d\nP"); Defaults: point and prefix (C-u)
  (save-excursion
    (goto-char from)
    (ess-rep-regexp (concat "\\([^ \t\n]\\)\\(\\<" word "\\>\\)")
                    "\\1 \\2" nil nil verbose)
    (goto-char from)
    (ess-rep-regexp (concat "\\(\\<" word "\\>\\)\\([^ \t\n]\\)")
                    "\\1 \\2" nil nil verbose)
    )
  )

(defun ess-time-string (&optional clock)
  "Returns a string for use as a timestamp. + hr:min if CLOCK is non-nil,
 like \"13 Mar 1992\".  Redefine to taste."
  (format-time-string (concat "%e %b %Y" (if clock ", %H:%M"))))


;;- From: friedman@gnu.ai.mit.edu (Noah Friedman)
;;- Date: 12 Feb 1995 21:30:56 -0500
;;- Newsgroups: gnu.emacs.sources
;;- Subject: nuke-trailing-whitespace
;;-
;;- This is too trivial to make into a big todo with comments and copyright
;;- notices whose length exceed the size of the actual code, so consider it
;;- public domain.  Its purpose is along similar lines to that of
;;- `require-final-newline', which is built in.  I hope the names make it
;;- obvious.

;; use
;; (add-hook 'write-file-functions 'ess-nuke-trailing-whitespace)

(defvar ess-nuke-trailing-whitespace-p nil;disabled by default  'ask
  "*[Dis]activates (ess-nuke-trailing-whitespace).
 Disabled if `nil'; if `t', it works unconditionally, otherwise,
 the user is queried.
 Note that setting the default to `t' may not be a good idea when you edit
 binary files!")

;;; MM: Newer Emacsen now have  delete-trailing-whitespace
;;; --  but no customization like  nuke-trailing-whitespace-p ..
(defun ess-nuke-trailing-whitespace ()
  "Nuke all trailing whitespace in the buffer.
Whitespace in this case is just spaces or tabs.
This is a useful function to put on write-file-hooks.

If the variable `ess-nuke-trailing-whitespace-p' is `nil', this function is
disabled.  If `t', unreservedly strip trailing whitespace.
If not `nil' and not `t', query for each instance."
  (interactive)
  (let ((bname (buffer-name)))
    (cond ((or
            (string= major-mode "rmail-mode")
            (string= bname "RMAIL")
            nil)); do nothing..

          (t
           (and (not buffer-read-only)
                ess-nuke-trailing-whitespace-p
                (save-match-data
                  (save-excursion
                    (save-restriction
                      (widen)
                      (goto-char (point-min))
                      (cond ((eq ess-nuke-trailing-whitespace-p t)
                             (while (re-search-forward "[ \t]+$" (point-max) t)
                               (delete-region (match-beginning 0)
                                              (match-end 0))))
                            (t
                             (query-replace-regexp "[ \t]+$" "")))))))))
    ;; always return nil, in case this is on write-file-hooks.
    nil))

(defun ess-kermit-get (&optional ess-file-arg ess-dir-arg)
  "Get a file with Kermit.  WARNING:  Experimental!  From your *shell*
buffer, start kermit and then log in to the remote machine.  Open
a file that starts with `ess-kermit-prefix'.  From that buffer,
execute this command.  It will retrieve a file from the remote
directory that you specify with the same name, but without the
`ess-kermit-prefix'."

  (interactive)

  ;;     (save-match-data
  (let ((ess-temp-file (if ess-file-arg ess-file-arg (buffer-name)))
        (ess-temp-file-remote-directory ess-dir-arg))

    (if (string-equal ess-kermit-prefix (substring ess-temp-file 0 1))
        (progn
          ;; I think there is a bug in the buffer-local variable handling in GNU Emacs 21.3
          ;; Setting ess-kermit-remote-directory every time is somehow resetting it to the
          ;; default on the second pass.  So, here's a temporary work-around.  It will fail
          ;; if you change the default, so maybe this variable should not be customizable.
          ;; In any case, there is also trouble with local variables in XEmacs 21.4.9 and
          ;; 21.4.10.  XEmacs 21.4.8 is fine.
          (if ess-temp-file-remote-directory
              (setq ess-kermit-remote-directory ess-temp-file-remote-directory)

            (if (string-equal "." ess-kermit-remote-directory)
                (setq ess-kermit-remote-directory (read-string "Remote directory to transfer file from: "
                                                               ess-kermit-remote-directory))))

          (setq ess-temp-file-remote-directory ess-kermit-remote-directory)
          ;;        (setq ess-temp-file (substring ess-temp-file (match-end 0)))
          (ess-sas-goto-shell)
          (insert "cd " ess-temp-file-remote-directory "; " ess-kermit-command " -s "
                  (substring ess-temp-file 1) " -a " ess-temp-file)
          (comint-send-input)
          ;;          (insert (read-string "Press Return to connect to Kermit: " nil nil "\C-\\c"))
          ;;        (comint-send-input)
          ;;        (insert (read-string "Press Return when Kermit is ready to recieve: " nil nil
          ;;                (concat "receive ]" ess-sas-temp-file)))
          ;;        (comint-send-input)
          ;;        (insert (read-string "Press Return when transfer is complete: " nil nil "c"))
          ;;        (comint-send-input)
          (insert (read-string "Press Return when shell is ready: "))
          (comint-send-input)
          (switch-to-buffer (find-buffer-visiting ess-temp-file))
          (ess-revert-wisely)
          ))))

(defun ess-kermit-send ()
  "Send a file with Kermit.  WARNING:  Experimental!  From
a file that starts with `ess-kermit-prefix',
execute this command.  It will transfer this file to the remote
directory with the same name, but without the `ess-kermit-prefix'."

  (interactive)

  ;;     (save-match-data
  (let ((ess-temp-file (expand-file-name (buffer-name)))
        (ess-temp-file-remote-directory nil))

    (if (string-equal ess-kermit-prefix (substring (file-name-nondirectory ess-temp-file) 0 1))
        (progn
          ;; I think there is a bug in the buffer-local variable handling in GNU Emacs 21.3
          ;; Setting ess-kermit-remote-directory every time is somehow resetting it to the
          ;; default on the second pass.  Here's a temporary work-around.  It will fail
          ;; if you change the default, so maybe this variable should not be customizable.
          ;; In any case, there is also trouble with local variables in XEmacs 21.4.9 and
          ;; 21.4.10.  XEmacs 21.4.8 is fine.
          (if (string-equal "." ess-kermit-remote-directory)
              (setq ess-kermit-remote-directory (read-string "Remote directory to transfer file to: "
                                                             ess-kermit-remote-directory)))

          (setq ess-temp-file-remote-directory ess-kermit-remote-directory)

          ;;        (setq ess-temp-file (substring ess-temp-file (match-end 0)))
          (ess-sas-goto-shell)
          (insert "cd " ess-temp-file-remote-directory "; " ess-kermit-command " -a "
                  (substring (file-name-nondirectory ess-temp-file) 1) " -g "  ess-temp-file)
          (comint-send-input)
          ;;          (insert (read-string "Press Return to connect to Kermit: " nil nil "\C-\\c"))
          ;;        (comint-send-input)
          ;;        (insert (read-string "Press Return when Kermit is ready to recieve: " nil nil
          ;;                (concat "receive ]" ess-sas-temp-file)))
          ;;        (comint-send-input)
          ;;        (insert (read-string "Press Return when transfer is complete: " nil nil "c"))
          ;;        (comint-send-input)
          (insert (read-string "Press Return when shell is ready: "))
          (comint-send-input)
          (switch-to-buffer (find-buffer-visiting ess-temp-file))
          (ess-revert-wisely)
          ))))

(defun ess-search-except (regexp &optional except backward)
  "Search for a regexp, store as match 1, optionally ignore
strings that match exceptions."
  (interactive)

  (let ((continue t) (exit nil))

    (while continue
      (if (or (and backward (search-backward-regexp regexp nil t))
              (and (not backward) (search-forward-regexp regexp nil t)))
          (progn
            (setq exit (match-string 1))
            (setq continue (and except (string-match except exit)))
            (if continue (setq exit nil)))
        ;;else
        (setq continue nil))
      )

    exit))

(defun ess-save-and-set-local-variables ()
  "If buffer was modified, save file and set Local Variables if defined.
Return t if buffer was modified, nil otherwise."
  (interactive)

  (let ((ess-temp-point (point))
        (ess-temp-return-value (buffer-modified-p)))
    ;; if buffer has changed, save buffer now (before potential revert)
    (if ess-temp-return-value (save-buffer))

    ;; If Local Variables are defined, update them now
    ;; since they may have changed since the last revert
    ;;  (save-excursion
    (beginning-of-line -1)
    (save-match-data
      (if (search-forward "End:" nil t) (revert-buffer t t)))
    ;; save-excursion doesn't save point in the presence of a revert
    ;; so you need to do it yourself
    (goto-char ess-temp-point)

    ess-temp-return-value))

(defun ess-get-file-or-buffer (file-or-buffer)
  "Return file-or-buffer if it is a buffer; otherwise return the buffer
associated with the file which must be qualified by it's path; if the
buffer does not exist, return nil."
  (interactive)

  (if file-or-buffer
      (if (bufferp file-or-buffer) file-or-buffer
        (find-buffer-visiting file-or-buffer))))

(defun ess-set-local-variables (alist &optional file-or-buffer)
  "Set local variables from ALIST in current buffer; if file-or-buffer
is specified, perform action in that buffer."
  (interactive)
  (if file-or-buffer (set-buffer (ess-get-file-or-buffer file-or-buffer)))

  (mapcar (lambda (pair)
            (make-local-variable (car pair))
            (set (car pair) (eval (cdr pair))))
          alist))

(defun ess-clone-local-variables (from-file-or-buffer
                                  &optional to-file-or-buffer)
  "Clone local variables from one buffer to another buffer."
  (interactive)
  (ess-set-local-variables
   (ess-sas-create-local-variables-alist from-file-or-buffer)
   to-file-or-buffer))

(defun ess-return-list (ess-arg)
  "Given an item, if it is a list return it, else return item in a list."
  (if (listp ess-arg) ess-arg (list ess-arg)))

(defun ess-find-exec (ess-root-arg ess-root-dir)
  "Given a root directory and the root of an executable file name,
find it's full name and path, if it exists, anywhere in the sub-tree."
  (let* ((ess-tmp-dirs (directory-files ess-root-dir t "^[^.]"))
         (ess-tmp-return (ess-find-exec-completions ess-root-arg ess-root-dir))
         (ess-tmp-dir nil))

    (while ess-tmp-dirs
      (setq ess-tmp-dir (car ess-tmp-dirs)
            ess-tmp-dirs (cdr ess-tmp-dirs))
      (if (file-accessible-directory-p ess-tmp-dir)
          (setq ess-tmp-return
                (nconc ess-tmp-return
                       (ess-find-exec ess-root-arg ess-tmp-dir)))))
    ess-tmp-return))

(defun ess-find-exec-completions (ess-root-arg &optional ess-exec-dir)
  "Given the root of an executable file name, find all possible completions.
Search for the executables in ESS-EXEC-DIR (which defaults to
`exec-path' if no value is given)."
  (let* ((ess-exec-path
          (if ess-exec-dir (ess-return-list ess-exec-dir) exec-path))
         (ess-tmp-exec nil)
         (ess-tmp-path-count (length ess-exec-path))
         (ess-tmp-dir nil)
         (ess-tmp-files nil)
         (ess-tmp-file nil))

    (while ess-exec-path
      (setq ess-tmp-dir (car ess-exec-path)
            ess-exec-path (cdr ess-exec-path))
      (when
          (and (> (length ess-tmp-dir) 0)
               (file-accessible-directory-p ess-tmp-dir))
        ;; the first test above excludes "" from exec-path, which can be
        ;; problematic with Tramp.
        (setq ess-tmp-files
              (file-name-all-completions ess-root-arg ess-tmp-dir))

        (while ess-tmp-files
          (setq ess-tmp-file
                (concat (file-name-as-directory ess-tmp-dir)
                        (car ess-tmp-files))
                ess-tmp-files (cdr ess-tmp-files))
          (if (and (file-executable-p ess-tmp-file)
                   (not (file-directory-p ess-tmp-file)))
              ;; we have found a possible executable, so keep it.
              (setq ess-tmp-exec
                    (nconc ess-tmp-exec (list ess-tmp-file)))))))
    ess-tmp-exec))

;; Copyright (C) 1994 Simon Marshall.
;; Author: Simon Marshall <Simon.Marshall@mail.esrin.esa.it>
;; LCD Archive Entry:
;; unique|Simon Marshall|Simon.Marshall@mail.esrin.esa.it|
;; Functions and commands to uniquify lists or buffer text (cf. sort).
;; 23-Apr-1994|1.00|~/packages/unique.el.Z|
;;
;; MM: renamed from 'unique' to 'ess-unique', then
(defun ess-uniq (list predicate)
  "Uniquify LIST, stably, deleting elements using PREDICATE.
Return the list with subsequent duplicate items removed by side effects.
PREDICATE is called with an element of LIST and a list of elements from LIST,
and should return the list of elements with occurrences of the element removed.
This function will work even if LIST is unsorted.  See also `ess-uniq-list'."
  (let ((list list))
    (while list
      (setq list (setcdr list (funcall predicate (car list) (cdr list))))))
  list)

(defun ess-uniq-list (items)
  "Delete all duplicate entries in ITEMS list, calling `ess-uniq'."
  (ess-uniq items 'delete))

(defun ess-drop-non-directories (file-strings)
  "Drop all entries that do not \"look like\" directories."
  (ess-flatten-list (mapcar 'file-name-directory file-strings)))


(defun ess-flatten-list (&rest list)
  "Take the arguments and flatten them into one long list.
Drops 'nil' entries."
  ;; Taken from lpr.el
  ;; `lpr-flatten-list' is defined here (copied from "message.el" and
  ;; enhanced to handle dotted pairs as well) until we can get some
  ;; sensible autoloads, or `flatten-list' gets put somewhere decent.

  ;; (ess-flatten-list '((a . b) c (d . e) (f g h) i . j))
  ;; => (a b c d e f g h i j)
  (ess-flatten-list-1 list))

(defun ess-flatten-list-1 (list)
  (cond
   ((null list) (list))
   ((consp list)
    (append (ess-flatten-list-1 (car list))
            (ess-flatten-list-1 (cdr list))))
   (t (list list))))

(defun ess-delete-blank-lines ()
  "Convert 2 or more lines of white space into one."
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (save-match-data
      (while (search-forward-regexp "^[ \t]*\n[ \t]*\n" nil t)
        ;;(goto-char (match-beginning 0))
        (delete-blank-lines)))))

(defun ess-do-auto-fill ()
  "This is the same as \\[do-auto-fill] in GNU emacs 21.3, with one major
difference: if we could not find a suitable place to break the line,
we simply do not break it (instead of breaking after the first word)."
  (let (fc justify bol give-up
           (fill-prefix fill-prefix))
    (if (or (not (setq justify (current-justification)))
            (null (setq fc (current-fill-column)))
            (and (eq justify 'left)
                 (<= (current-column) fc))
            (save-excursion (beginning-of-line)
                            (setq bol (point))
                            (and auto-fill-inhibit-regexp
                                 (looking-at auto-fill-inhibit-regexp))))
        nil ;; Auto-filling not required
      (if (memq justify '(full center right))
          (save-excursion (unjustify-current-line)))

      ;; Choose a fill-prefix automatically.
      (if (and adaptive-fill-mode
               (or (null fill-prefix) (string= fill-prefix "")))
          (let ((prefix
                 (fill-context-prefix
                  (save-excursion (backward-paragraph 1) (point))
                  (save-excursion (forward-paragraph 1) (point)))))
            (and prefix (not (equal prefix ""))
                 (setq fill-prefix prefix))))

      (while (and (not give-up) (> (current-column) fc))
        ;; Determine where to split the line.
        (let* (after-prefix
               (fill-point
                (let ((opoint (point))
                      bounce
                      (first t))
                  (save-excursion
                    (beginning-of-line)
                    (setq after-prefix (point))
                    (and fill-prefix
                         (looking-at (regexp-quote fill-prefix))
                         (setq after-prefix (match-end 0)))
                    (move-to-column (1+ fc))
                    ;; Move back to the point where we can break the line.
                    ;; We break the line between word or
                    ;; after/before the character which has character
                    ;; category `|'.  We search space, \c| followed by
                    ;; a character, or \c| following a character.  If
                    ;; not found, place the point at beginning of line.
                    (while (or first
                               ;; If this is after period and a single space,
                               ;; move back once more--we don't want to break
                               ;; the line there and make it look like a
                               ;; sentence end.
                               (and (not (bobp))
                                    (not bounce)
                                    sentence-end-double-space
                                    (save-excursion (forward-char -1)
                                                    (and (looking-at "\\. ")
                                                         (not (looking-at "\\.  ")))))
                               (and (not (bobp))
                                    (not bounce)
                                    fill-nobreak-predicate
                                    (funcall fill-nobreak-predicate)))
                      (setq first nil)
                      (re-search-backward "[ \t]\\|\\c|.\\|.\\c|\\|^")
                      ;; If we find nowhere on the line to break it,
                      ;; do not break it.  Set bounce to t
                      ;; so we will not keep going in this while loop.
                      (if (<= (point) after-prefix)
                          (setq bounce t)
                        (if (looking-at "[ \t]")
                            ;; Break the line at word boundary.
                            (skip-chars-backward " \t")
                          ;; Break the line after/before \c|.
                          (forward-char 1))))
                    (if enable-multibyte-characters
                        ;; If we are going to break the line after or
                        ;; before a non-ascii character, we may have
                        ;; to run a special function for the charset
                        ;; of the character to find the correct break
                        ;; point.
                        (if (not (and (eq (charset-after (1- (point))) 'ascii)
                                      (eq (charset-after (point)) 'ascii)))
                            (fill-find-break-point after-prefix)))

                    ;; Let fill-point be set to the place where we end up.
                    ;; But move back before any whitespace here.
                    (skip-chars-backward " \t")
                    (point)))))

          ;; See whether the place we found is any good.
          (if (save-excursion
                (goto-char fill-point)
                (and (not (bolp))
                     ;; There is no use breaking at end of line.
                     (not (save-excursion (skip-chars-forward " ") (eolp)))
                     ;; It is futile to split at the end of the prefix
                     ;; since we would just insert the prefix again.
                     (not (and after-prefix (<= (point) after-prefix)))
                     ;; Don't split right after a comment starter
                     ;; since we would just make another comment starter.
                     (not (and comment-start-skip
                               (let ((limit (point)))
                                 (beginning-of-line)
                                 (and (re-search-forward comment-start-skip
                                                         limit t)
                                      (eq (point) limit)))))))
              ;; Ok, we have a useful place to break the line.  Do it.
              (let ((prev-column (current-column)))
                ;; If point is at the fill-point, do not `save-excursion'.
                ;; Otherwise, if a comment prefix or fill-prefix is inserted,
                ;; point will end up before it rather than after it.
                (if (save-excursion
                      (skip-chars-backward " \t")
                      (= (point) fill-point))
                    (funcall comment-line-break-function t)
                  (save-excursion
                    (goto-char fill-point)
                    (funcall comment-line-break-function t)))
                ;; Now do justification, if required
                (if (not (eq justify 'left))
                    (save-excursion
                      (end-of-line 0)
                      (justify-current-line justify nil t)))
                ;; If making the new line didn't reduce the hpos of
                ;; the end of the line, then give up now;
                ;; trying again will not help.
                (if (>= (current-column) prev-column)
                    (setq give-up t)))
            ;; No good place to break => stop trying.
            (setq give-up t))))
      ;; Justify last line.
      (justify-current-line justify t t)
      t)))

(defun ess-select-frame-set-input-focus (frame)
  "Select FRAME, raise it, and set input focus, if possible.
Copied almost verbatim from gnus-utils.el (but with test for mac added)."
  (cond ((featurep 'xemacs)
         (raise-frame frame)
         (select-frame frame)
         (focus-frame frame))
        ;; The function `select-frame-set-input-focus' won't set
        ;; the input focus under Emacs 21.2 and X window system.
        ;;((fboundp 'select-frame-set-input-focus)
        ;; (defalias 'gnus-select-frame-set-input-focus
        ;;   'select-frame-set-input-focus)
        ;; (select-frame-set-input-focus frame))
        (t
         (raise-frame frame)
         (select-frame frame)
         (cond ((and
                 (memq window-system '(x mac))
                 (fboundp 'x-focus-frame))
                (x-focus-frame frame))
               ((eq window-system 'w32)
                (w32-focus-frame frame)))
         (when focus-follows-mouse
           (set-mouse-position frame (1- (frame-width frame)) 0)))))

(defun ess-sci-to-dec ()
  "For BUGS/S family: Express +/-0.000E+/-0 or +/-0.0e+/-00 as a decimal."
  (interactive)
  (setq buffer-read-only nil)
  (save-excursion (goto-char 0)
                  (save-match-data (let ((ess-temp-replacement-string nil)
                                         (ess-temp-replacement-9 0)
                                         (ess-temp-replacement-diff 0))
                                     (while (search-forward-regexp "-?[0-9][.][0-9][0-9]?[0-9]?[Ee][+-][0-9][0-9]?" nil t)
                                       (setq ess-temp-replacement-string
                                             (int-to-string (string-to-number (match-string 0))))
                                       (setq ess-temp-replacement-diff (- (match-end 0) (match-beginning 0)))
                                       (save-match-data
                                         (setq ess-temp-replacement-9
                                               (string-match "99999999999$" ess-temp-replacement-string))

                                         (if (not ess-temp-replacement-9)
                                             (setq ess-temp-replacement-9
                                                   (string-match "000000000001$" ess-temp-replacement-string))))

                                       (if ess-temp-replacement-9
                                           (setq ess-temp-replacement-string
                                                 (substring ess-temp-replacement-string 0 ess-temp-replacement-9)))

                                       (setq ess-temp-replacement-diff
                                             (- ess-temp-replacement-diff (string-width ess-temp-replacement-string)))

                                       (while (> ess-temp-replacement-diff 0)
                                         (setq ess-temp-replacement-string (concat ess-temp-replacement-string " "))
                                         (setq ess-temp-replacement-diff (- ess-temp-replacement-diff 1)))

                                       (replace-match ess-temp-replacement-string))))))

(defun ess-num-or-zero (arg)
  "*If a number, then return that number, otherwise return 0."
  (or (and (numberp arg) arg) 0))


 ; Timer management

(defcustom ess-idle-timer-interval 1
  "Number of idle seconds to wait before running function in
  `ess-idle-timer-functions'."
  :group 'ess)

(defvar ess-idle-timer-functions nil
  "A list of functions to run each `ess-idle-timer-interval' idle seconds.

If your function calls the process, you better use
`ess-when-new-input' to wrap your call. If you call the
subprocess please respect `ess-can-eval-in-background' variable.

These functions are run with `run-hooks'. Use `add-hook' to add
symbols to this variable.

Most likely you will need a local hook. Then you should specify
the LOCAL argument to `add-hook' and initialise it in
`ess-mode-hook' or `ess-post-run-hook', or one of the more
specialised hooks `ess-R-post-run-hook',`ess-stata-post-run-hook'
etc.
")

(defun ess--idle-timer-function nil
  "Internal function executed by `ess--idle-timer'"
  ;; (while-no-input
  (run-hooks 'ess-idle-timer-functions))

(require 'timer)
(defvar ess--idle-timer
  (run-with-idle-timer ess-idle-timer-interval 'repeat 'ess--idle-timer-function)
  "Timer used to run `ess-idle-timer-functions'.")

(defmacro ess-when-new-input (time-var &rest body)
  "BODY is evaluate only if the value of procss variable TIME-VAR
is bigger than the time of the last user input (stored in
'last-eval' process variable). TIME-VAR is the name of the
process variable which holds the access time. See the code for
`ess-synchronize-dirs' and `ess-cache-search-list'.

Returns nil when no current process, or process is busy, or
time-var > last-eval. Otherwise, execute BODY and return the last
value.

If BODY is executed, set process variable TIME-VAR
to (current-time).

Variable  *proc*  is bound  to  the  current process  during  the
evaluation of BODY.

Should be used in `ess-idle-timer-functions' which call the
process to avoid excessive requests.
"
  (declare (indent 1) (debug t))
  `(with-ess-process-buffer 'no-error
     (let ((le (process-get *proc* 'last-eval))
           (tv (process-get *proc* ',time-var)))
       (when (and (or (null tv) (null le) (time-less-p tv le))
                  (not (process-get *proc* 'busy)))
         (let ((out (progn ,@body)))
           (process-put *proc* ',time-var (current-time))
           out)))))


(defmacro ess--execute-electric-command (map &optional prompt wait exit-form &rest args)
  "Execute single-key comands defined in MAP till a key is pressed which is not part of map.

Return the value of the lastly executed command.

Single-key input commands are those that once executed do not
requre the prefix command for subsequent invocation.

PROMPT is passed to `read-event'.

If WAIT is t, wait for next input and ignore the keystroke which
triggered the command.

Each command in map should accept one at least one argument, the
most recent event (as read by `read-event'). ARGS are the
supplementary arguments passed to the commands.

EXIT-FORM should be supplied for a more refined control of the
read-even loop. The loop is exited when EXIT-FORM evaluates to
t. See examples in the tracebug code.
"
  ;;VS[09-06-2013]: check: it seems that set-temporary-overlay-map is designed
  ;;for this type of things; see also repeat.el package.
  `(let* ((ev last-command-event)
          (command (lookup-key ,map (vector ev)))
          out exit )
     (if (not (or ,wait command))
         (message "%s is undefined" (key-description (this-command-keys)))
       (unless ,wait
         (setq out (and command (funcall command ev ,@args))))
       (while (and (not exit)
                   (setq command
                         (lookup-key ,map
                                     (vector (setq ev (read-event ,prompt))))))
         (setq out (funcall command ev ,@args))
         (sleep-for .01)
         (setq exit ,exit-form))
       (unless exit ;; push only if an event triggered the exit
         (push ev unread-command-events))
       out)))

(defmacro ess-execute-dialect-specific (command &optional prompt &rest args)
  "Execute dialect specific command.

-- If command is nil issue warning 'Not available for dialect X'
-- If command is a elisp function, execute it with ARGS
-- If a string starting with 'http' or 'www', browse with `browse-url',
   otherwise execute the command in inferior process.
-- If a string, interpret as a command to subprocess, and
   substitute ARGS with `(format ,command ,@args).

When PROMPT is non-nil ask the user for a string value and
prepend the response to ARGS.

If prompt is a string just pass it to `read-string'. If a list, pass it
to `ess-completing-read'.
"
  `(if (null ,command)
       (message "Not implemented for dialect %s" ess-dialect)
     (let* ((com  (if (symbolp ,command)
                     (symbol-function ,command)
                   ,command))
            (prompt ',prompt)
            (resp (and prompt
                       (if (stringp  prompt)
                           (read-string  prompt)
                         (apply 'ess-completing-read prompt))))
            (args (append (list resp) ',args)))
       (cond ((functionp com)
              (apply com args))
             ((and (stringp com)
                   (string-match "^\\(http\\|www\\)" com))
              (setq com (apply 'format com args))
              (require 'browse-url)
              (browse-url com))
             ((stringp com)
              (unless (string-match "\n$" com)
                (setq com (concat com "\n")))
              (setq com (apply 'format com args))
              (ess-eval-linewise com))
             (t
              (error "Argument COMMAND must be either a function or a string"))))))



;; SJE: 2009-01-30 -- this contribution from
;; Erik Iverson <iverson@biostat.wisc.edu>

(defun ess-tooltip-show-at-point (text xo yo)
  "Show a tooltip displaying 'text' at (around) point, xo and yo are x-
and y-offsets for the toolbar from point."
  (let (
        (fx (frame-parameter nil 'left))
        (fy (frame-parameter nil 'top))
        (fw (frame-pixel-width))
        (fh (frame-pixel-height))
        frame-left frame-top my-x-offset my-y-offset)

    ;; The following comment was found before code looking much like that
    ;; of frame-left and frame-top below in the file
    ;; tooltip-help.el. I include it here for acknowledgement, and I did observe
    ;; the same behavior with the Emacs window maximized under Windows XP.

    ;; -----original comment--------
    ;; handles the case where (frame-parameter nil 'top) or
    ;; (frame-parameter nil 'left) return something like (+ -4).
    ;; This was the case where e.g. Emacs window is maximized, at
    ;; least on Windows XP. The handling code is "shamelessly
    ;; stolen" from cedet/speedbar/dframe.el
    ;; (contributed by Andrey Grigoriev)

    (setq frame-left (if (not (consp fx))
                         fx
                       (if (eq (car fx) '-)
                           (- (x-display-pixel-width) (car (cdr fx)) fw)
                         (car (cdr fx)))))

    (setq frame-top (if (not (consp fy))
                        fy
                      (if (eq (car fy) '-)
                          (- (x-display-pixel-height) (car (cdr fy)) fh)
                        (car (cdr fy)))))

    ;; calculate the offset from point, use xo and yo to adjust to preference
    (setq my-x-offset (+ (car(window-inside-pixel-edges))
                         (car(posn-x-y (posn-at-point)))
                         frame-left xo))

    (setq my-y-offset (+ (cadr(window-inside-pixel-edges))
                         (cdr(posn-x-y (posn-at-point)))
                         frame-top yo))

    (let ((tooltip-frame-parameters
           (cons (cons 'top my-y-offset)
                 (cons (cons 'left my-x-offset)
                       tooltip-frame-parameters))))
      (tooltip-show text))
    ))


;; (defun ess-tooltip-show-at-point (text xo yo)
;;   (with-no-warnings
;;     (pos-tip-show text
;;                   'popup-tip-face
;;                   (point)
;;                   nil tooltip-hide-delay
;;                   popup-tip-max-width
;;                   nil xo yo)))


(defvar ess-build-tags-command nil
  "Command passed to generate tags.

If nil, `ess-build-tags-for-directory' uses the mode's imenu
regexpresion. Othersiwe, it should be a string with two %s
formats: one for directory and another for the output file.")


(defun ess-build-tags-for-directory (dir tagfile)
  "Ask for directory and tag file and build tags for current dialect.

If the current language defines `ess-build-tags-command' use it
and ask the subprocess to build the tags. Otherwise use imenu
regexp and call find .. | etags .. in a shell command. You must
have 'find' and 'etags' programs installed.

Use M-. to navigate to a tag. M-x `visit-tags-table' to
append/replace the currently used tag table.

If prefix is given, force tag generation based on imenu. Might be
useful when different language files are also present in the
directory (.cpp, .c etc)."
  (interactive "DDirectory to tag:
GTags file (default TAGS): ")
  (when (or (eq (length (file-name-nondirectory tagfile)) 0)
            (file-directory-p tagfile))
    (setq tagfile (concat (file-name-as-directory tagfile) "TAGS")))
  ;; emacs find-tags doesn't play well with remote TAG files :(
  (when (file-remote-p tagfile)
    (require 'tramp)
    (setq tagfile (with-parsed-tramp-file-name tagfile foo foo-localname)))
  (when (file-remote-p dir)
    (setq dir (with-parsed-tramp-file-name dir foo foo-localname)))
  (if (and ess-build-tags-command (null current-prefix-arg))
      (ess-eval-linewise (format ess-build-tags-command dir tagfile))
    ;; else generate from imenu
    (unless (or imenu-generic-expression ess-imenu-generic-expression) ;; need both!!
      (error "No ess-tag-command found, and no imenu-generic-expression defined"))
    (let* ((find-cmd
            (format "find %s -type f -size 1M \\( -regex \".*\\.\\(cpp\\|jl\\|[RsrSch]\\(nw\\)?\\)$\" \\)" dir))
           (regs (delq nil (mapcar (lambda (l)
                                     (if (string-match "'" (cadr l))
                                         nil ;; remove for time being
                                       (format "/%s/\\%d/"
                                               (replace-regexp-in-string "/" "\\/" (nth 1 l) t)
                                               (nth 2 l))))
                                   imenu-generic-expression)))
           (tags-cmd (format "etags -o %s --regex='%s' -" tagfile
                             (mapconcat 'identity regs "' --regex='"))))
      (message "Building tags: %s" tagfile)
      ;; (dbg (format "%s | %s" find-cmd tags-cmd))
      (when (= 0 (shell-command (format "%s | %s" find-cmd tags-cmd)))
        (message "Building tags .. ok!")))))


(defun ess-function-arguments (funname &optional proc)
  "Get FUNARGS from cache or ask the process for it.

Return FUNARGS - a list with the first element being a
cons (package_name . time_stamp_of_request), second element is a
string giving arguments of the function as they appear in
documentation, third element is a list of arguments of all
methods.

If package_name is nil, and time_stamp is less recent than the
time of the last user interaction to the process, then update the
entry.

Package_name is also nil when funname was not found, or funname
is a special name that contains :,$ or @.

If PROC is given, it should be an ESS process which should be
queried for arguments.
"

  (when (and funname ;; usually returned by ess--funname.start (might be nil)
             (or proc (ess-process-live-p)))
    (let* ((proc (or proc (get-process ess-local-process-name)))
           (args (gethash funname (process-get proc 'funargs-cache)))
           (pack (caar args))
           (ts   (cdar args)))
      (when (and args
                 (and (time-less-p ts (process-get proc 'last-eval))
                      (or (null pack)
                          (equal pack ""))))
        ;; reset cache
        (setq args nil))
      (or args
          (cadr (assoc funname (process-get proc 'funargs-pre-cache)))
	  (and 
	   (not (process-get proc 'busy))
	   (with-current-buffer (ess-command (format ess-funargs-command
						     (ess-quote-special-chars funname))
					     nil nil nil nil proc)
	     (goto-char (point-min))
	     (when (re-search-forward "(list" nil t)
	       (goto-char (match-beginning 0))
	       (setq args (ignore-errors (eval (read (current-buffer)))))
	       (if args
		   (setcar args (cons (car args) (current-time)))))
	     ;; push even if nil
	     (puthash (substring-no-properties funname) args (process-get proc 'funargs-cache))))))))

(defun ess-symbol-at-point ()
  "Like `symbol-at-point' but consider fully qualified names.
Fully qualified names include accessor symbols (like aaa$bbb and
aaa@bbb in R)."
  (with-syntax-table (or ess-mode-completion-syntax-table
                         ess-mode-syntax-table
                         (syntax-table))
    (symbol-at-point)))

(defun ess-symbol-start ()
  "Get initial position for objects completion.
Symbols are fully qualified names that include accessor
symbols (like aaa$bbb and aaa@bbb in R)."
  (let ((beg (car (with-syntax-table (or ess-mode-completion-syntax-table
                                         ess-mode-syntax-table
                                         (syntax-table))
                    (bounds-of-thing-at-point 'symbol)))))
    (when (and beg (not (save-excursion (goto-char beg)
                                        (looking-at "/\\|.[0-9]"))))
      beg)))

(defun ess-arg-start ()
  "Get initial position for args completion"
  (when (not (ess-inside-string-p))
    (when (ess--funname.start)
      (if (looking-back "[(,]+[ \t\n]*")
          (point)
        (ess-symbol-start)))))

(defvar ess--funname.start nil)

(defun ess--funname.start (&optional look-back)
  "If inside a function call, return (FUNNAMME . START) where
FUNNAME is a function name found before ( and START is where
FUNNAME starts.

LOOK-BACK is a number of characters to look back; defaults to
2000. As the search might get quite slow for files with thousands
of lines.

Also store the cons in 'ess--funname.start for potential use
later."
  (save-excursion
    (save-restriction
     (let* ((proc (get-buffer-process (current-buffer)))
            (mark (and proc (process-mark proc))))

       (if (and mark (>= (point) mark))
           (narrow-to-region mark (point)))

       (and ess-noweb-mode
            (ess-noweb-narrow-to-chunk))

       (unless (ess-inside-string-p)
         (setq ess--funname.start
               (condition-case nil ;; check if it is inside a functon
                   (progn
                     ;; for the sake of big buffers, look only 1000 chars back
                     (narrow-to-region (max (point-min) (- (point) 1000)) (point))
                     (up-list -1)
                     (while (not (looking-at "("))
                       (up-list -1))
                     (let ((funname (symbol-name (ess-symbol-at-point))))
                       (when (and funname
                                  (not (member funname ess-S-non-functions)))
                         (cons funname (- (point) (length funname))))
                       ))
                 (error nil))
               ))))))

(defun ess--inject-code-from-file (file)
  ;; this is different from ess-load-file
  (let ((content (with-temp-buffer
                   (insert-file-contents file)
                   (buffer-string))))
    (when (string= ess-dialect "R")
      ;; don't detect intermediate prompts
      (setq content (concat "{" content "}\n")))
    (ess-command content)))

(defvar ess-current-region-overlay
  (let ((overlay (make-overlay (point) (point))))
    (overlay-put overlay 'face  'highlight)
    overlay)
  "The overlay for highlighting currently evaluated region or line.")

(defun ess-blink-region (start end)
  (when ess-blink-region
    (move-overlay ess-current-region-overlay start end)
    (run-with-timer ess-blink-delay nil
                    (lambda ()
                      (delete-overlay ess-current-region-overlay)))))

(defun ess-deactivate-mark ()
  (cond ((and (featurep 'evil) evil-mode)
         (when (evil-visual-state-p)
           (evil-normal-state)))
        ((fboundp 'deactivate-mark)
         (deactivate-mark))))

(defun ess-replace-in-string (str regexp newtext &optional literal)
  "Replace all matches in STR for REGEXP with NEWTEXT string.
Optional LITERAL non-nil means do a literal replacement.
Otherwise treat \\ in NEWTEXT string as special:
  \\& means substitute original matched text,
  \\N means substitute match for \(...\) number N,
  \\\\ means insert one \\."
  (if (not (stringp str))
      (error "(replace-in-string): First argument must be a string: %s" str))
  (if (stringp newtext)
      nil
    (error "(replace-in-string): 3rd arg must be a string: %s"
           newtext))
  (let ((rtn-str "")
        (start 0)
        (special)
        match prev-start)
    (while (setq match (string-match regexp str start))
      (setq prev-start start
            start (match-end 0)
            rtn-str
            (concat
             rtn-str
             (substring str prev-start match)
             (cond (literal newtext)
                   (t (mapconcat
                       (function
                        (lambda (c)
                          (if special
                              (progn
                                (setq special nil)
                                (cond ((eq c ?\\) "\\")
                                      ((eq c ?&)
                                       (substring str
                                                  (match-beginning 0)
                                                  (match-end 0)))
                                      ((and (>= c ?0) (<= c ?9))
                                       (if (> c (+ ?0 (length
                                                       (match-data))))
                                           ;; Invalid match num
                                           (error "(replace-in-string) Invalid match num: %c" c)
                                         (setq c (- c ?0))
                                         (substring str
                                                    (match-beginning c)
                                                    (match-end c))))
                                      (t (char-to-string c))))
                            (if (eq c ?\\) (progn (setq special t) nil)
                              (char-to-string c)))))
                       newtext ""))))))
    (concat rtn-str (substring str start))))

(defun ess-kill-last-line ()
  (save-excursion
    (goto-char (point-max))
    (forward-line -1)
    (delete-region (point-at-eol) (point-max))))

(defvar ess-adjust-chunk-faces t
  "Whether to adjust background color in code chunks.")

(defvar-local ess-buffer-has-chunks nil
  "Internal usage: indicates whether a buffer has chunks.
This is used to make face adjustment a no-op when a buffer does
not contain chunks.")

(defvar ess-adjust-face-intensity 2
  "Default intensity for adjusting faces.")

(defun ess-adjust-face-background (start end &optional intensity)
  "Adjust face background between BEG and END.
On dark background, lighten.  Oposite on light."
  (let* ((intensity (or intensity ess-adjust-face-intensity))
         (color (color-lighten-name
                 (face-background 'default)
                 (if (eq (frame-parameter nil 'background-mode) 'light)
                     (- intensity)
                   intensity)))
         (face (list (cons 'background-color color))))
    (with-silent-modifications
      (ess-adjust-face-properties start end 'face face))))

;; Taken from font-lock.el.
(defun ess-adjust-face-properties (start end prop value)
  "Tweaked `font-lock-prepend-text-property'.
Adds the `ess-face-adjusted' property so we only adjust face once."
  (let ((val (if (listp value) value (list value))) next prev)
    (while (/= start end)
      (setq next (next-single-property-change start prop nil end)
            prev (get-text-property start prop))
      ;; Canonicalize old forms of face property.
      (and (memq prop '(face font-lock-face))
           (listp prev)
           (or (keywordp (car prev))
               (memq (car prev) '(foreground-color background-color)))
           (setq prev (list prev)))
      (add-text-properties start next
                           (list prop (append val (if (listp prev) prev (list prev)))
                                 'ess-face-adjusted t))
      (setq start next))))

(defun ess-find-overlay (pos prop)
  (cl-some (lambda (overlay)
             (when (overlay-get overlay prop)
               overlay))
           (overlays-at pos)))

(provide 'ess-utils)

;;; ess-utils.el ends here