forked from emacs-ess/ESS
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathess-inf.el
3422 lines (3009 loc) · 143 KB
/
ess-inf.el
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
;;; ess-inf.el --- Support for running S as an inferior Emacs process
;; Copyright (C) 1989-1994 Bates, Kademan, Ritter and Smith
;; Copyright (C) 1997-1999 A.J. Rossini <[email protected]>,
;; Martin Maechler <[email protected]>.
;; Copyright (C) 2000--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: David Smith <[email protected]>
;; Created: 7 Jan 1994
;; Maintainer: ESS-core <[email protected]>
;; This file is part of ESS
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; A copy of the GNU General Public License is available at
;; http://www.r-project.org/Licenses/
;;; Commentary:
;; Code for handling running ESS processes.
;;; Code:
; Requires and autoloads
;;*;; Requires
;; Byte-compiler, SHUT-UP!
(eval-and-compile
(require 'ess-utils))
(unless (featurep 'xemacs)
(require 'newcomment nil t))
(require 'comint)
(require 'overlay)
;;; VS: These autoloads are not needed. See coments in ess-mode.el.
;;*;; Autoloads
;; (autoload 'ess-parse-errors "ess-mode" "(autoload).")
;; (autoload 'ess-dump-object-into-edit-buffer "ess-mode" "(autoload).")
;; (autoload 'ess-beginning-of-function "ess-mode" "(autoload).")
;; (autoload 'ess-end-of-function "ess-mode" "(autoload).")
;; (autoload 'ess-display-help-on-object "ess-help" "(autoload).")
;; (autoload 'ess-extract-word-name "ess-utils" "(autoload).")
;; (autoload 'ess-uniq-list "ess-utils" "(autoload).")
;; (autoload 'ess-transcript-send-command-and-move "ess-trns" "(autoload).")
;; (autoload 'ess-R-complete-object-name "ess-r-d" "(autoload).")
(autoload 'ess-eval-region-ddeclient "ess-dde" "(autoload).")
(autoload 'ess-eval-linewise-ddeclient "ess-dde" "(autoload).")
(autoload 'ess-load-file-ddeclient "ess-dde" "(autoload).")
(autoload 'ess-command-ddeclient "ess-dde" "(autoload).")
(autoload 'tramp-tramp-file-p "tramp" "(autoload).")
(autoload 'tramp-file-name-localname "tramp" "(autoload).")
(autoload 'tramp-dissect-file-name "tramp" "(autoload).")
(autoload 'with-parsed-tramp-file-name "tramp" "(autolaod).")
;; not really needed as tracebug and developer are loaded in r-d.el
(autoload 'ess-tracebug-send-region "ess-tracebug" "(autoload).")
(autoload 'ess-developer-send-function "ess-developer" "(autoload).")
;;*;; Process handling
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; In this section:
;;;
;;; * User commands for starting an ESS process
;;; * Functions called at startup
;;; * Process handling code
;;; * Multiple process implementation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;*;; Starting a process
(defun ess-proc-name (n name)
"Return name of process N, as a string, with NAME prepended.
If ess-plain-first-buffername, then initial process is number-free."
(concat name
(if (not (and ess-plain-first-buffername
(= n 1))) ; if not both first and plain-first add number
(concat ":" (number-to-string n)))))
(defun inferior-ess (&optional ess-start-args customize-alist no-wait)
"Start inferior ESS process.
Without a prefix argument, starts a new ESS process, or switches
to the ESS process associated with the current buffer.
With a prefix, starts the process with those args.
The current buffer is used if it is an `inferior-ess-mode'
or `ess-transcript-mode' buffer.
If `ess-ask-about-transfile' is non-nil, you will be asked for a
transcript file to use. If there is no transcript file, the buffer
name will be like *S* or *S2*.
Takes the program name from the variable `inferior-ess-program'.
An initialization file (dumped into the process) is specified by
`inferior-ess-start-file', and `inferior-ess-start-args' is used to
accompany the call for `inferior-ess-program'.
When creating a new process, the process buffer replaces the
current window if `inferior-ess-same-window' is non-nil.
Alternatively, it can appear in its own frame if
`inferior-ess-own-frame' is non-nil.
\(Type \\[describe-mode] in the process buffer for a list of commands.)"
;; Use the current buffer if it is in inferior-ess-mode or ess-trans-mode
;; If not, maybe ask about starting directory and/or transcript file.
;; If no transfile, use buffer *S*
;;
;; This function is primarily used to figure out the Process and
;; buffer names to use for inferior-ess.
;; Once, long ago, it was used for switching buffers, but we don't
;; do that any more (at least not from here).
(interactive)
(let* ((ess-customize-alist (or customize-alist
ess-customize-alist))
(temp-ess-dialect (eval (cdr (assoc 'ess-dialect
ess-customize-alist))))
(temp-ess-lang (eval (cdr (assoc 'ess-language
ess-customize-alist)))))
(run-hooks 'ess-pre-run-hook)
(ess-write-to-dribble-buffer
(format "(inf-ess 1): lang=%s, dialect=%s, tmp-dialect=%s, buf=%s\n"
ess-language ess-dialect temp-ess-dialect (current-buffer)))
(let* ((process-environment process-environment)
(defdir (or (and ess-directory-function (funcall ess-directory-function))
ess-directory default-directory))
(temp-dialect (if ess-use-inferior-program-name-in-buffer-name ;VS[23-02-2013]: fixme: this should not be here
(if (string-equal temp-ess-dialect "R")
inferior-R-program-name
temp-ess-dialect) ; use temp-ess-dialect
; if not R, R program name
; otherwise.
temp-ess-dialect))
(temp-lang temp-ess-lang)
(procname (let ((ntry 0) ;; find the next non-existent process N (*R:N*)
(done nil))
(while (not done)
(setq ntry (1+ ntry)
done (not
(get-process (ess-proc-name
ntry
temp-dialect)))))
(ess-proc-name ntry temp-dialect)))
(buf-name-str (funcall ess-gen-proc-buffer-name-function procname))
startdir buf method)
(ess-write-to-dribble-buffer
(format "(inf-ess 1.1): procname=%s temp-dialect=%s, buf-name=%s \n"
procname temp-dialect buf-name-str))
(cond
;; 1) try to use current buffer, if inferior-ess-mode but no process
((and (not (comint-check-proc (current-buffer)))
(eq major-mode 'inferior-ess-mode))
(setq startdir (if ess-ask-for-ess-directory
(ess-get-directory defdir temp-dialect procname)
defdir)
buf (current-buffer)
;; don't change existing buffer name in this case; It is very
;; commong to restart the process in the same buffer.
buf-name-str (buffer-name)
method 1))
;; 2) Take the *R:N* buffer if already exists (and contains dead proc!)
;; fixme: buffer name might have been changed, iterate over all
;; inferior-ess buffers
((get-buffer buf-name-str)
(setq buf (get-buffer buf-name-str)
method 2))
;; 3) Pick up a transcript file or create a new buffer
(t
(setq startdir (if ess-ask-for-ess-directory
(ess-get-directory defdir temp-dialect procname)
defdir)
buf (if ess-ask-about-transfile
(let ((transfilename (read-file-name "Use transcript file (default none):"
startdir "")))
(if (string= transfilename "")
(get-buffer-create buf-name-str)
(find-file-noselect (expand-file-name transfilename))))
(get-buffer-create buf-name-str))
method 3)))
(ess-write-to-dribble-buffer
(format "(inf-ess 2.0) Method #%d start=%s buf=%s\n" method startdir buf))
(set-buffer buf)
;; Now that we have the buffer, set buffer-local variables.
(ess-setq-vars-local ess-customize-alist) ; buf)
;; Write out debug info
(ess-write-to-dribble-buffer
(format "(inf-ess 2.1): ess-language=%s, ess-dialect=%s buf=%s \n"
ess-language ess-dialect (current-buffer)))
;; initialize.
(if startdir (setq default-directory startdir))
;; the following was part of ess-multi;
(let* ((ess-directory (or startdir
ess-directory))
(infargs (or ess-start-args
inferior-ess-start-args))
(special-display-regexps nil)
(special-display-frame-alist inferior-ess-frame-alist)
(proc (get-process procname)))
(if inferior-ess-own-frame
(setq special-display-regexps '(".")))
;; If ESS process NAME is running, switch to it
(if (and proc (comint-check-proc (process-buffer proc)))
(progn ;; fixme: when does this happen? -> log:
(ess-write-to-dribble-buffer (format "(inf-ess ..): popping to proc\n"))
(pop-to-buffer (process-buffer proc)))
;; Otherwise, crank up a new process
(let* ((symbol-string
(concat "inferior-" inferior-ess-program "-args"))
(switches-symbol (intern-soft symbol-string))
(switches
(if (and switches-symbol (boundp switches-symbol))
(symbol-value switches-symbol))))
(set-buffer buf)
(inferior-ess-mode)
(ess-write-to-dribble-buffer
(format "(inf-ess 3.0): prog=%s, start-args=%s, echoes=%s\n"
inferior-ess-program infargs comint-process-echoes))
(setq ess-local-process-name procname)
(goto-char (point-max))
;; load past history
;; Set up history file
(if ess-history-file
(if (eq t ess-history-file)
(set (make-variable-buffer-local 'ess-history-file)
(concat "." ess-dialect "history"))
;; otherwise must be a string "..."
(unless (stringp ess-history-file)
(error "`ess-history-file' must be nil, t, or a string"))))
(when ess-history-file
(setq comint-input-ring-file-name
(expand-file-name ess-history-file
(or ess-history-directory ess-directory)))
(comint-read-input-ring))
;; create and run process.
(set-buffer
(if switches
(inferior-ess-make-comint buf-name-str
procname
infargs
switches)
(inferior-ess-make-comint buf-name-str
procname
infargs)))
;; Set the process sentinel to save the history
(set-process-sentinel (get-process procname) 'ess-process-sentinel)
;; Add this process to ess-process-name-list, if needed
(let ((conselt (assoc procname ess-process-name-list)))
(if conselt nil
(setq ess-process-name-list
(cons (cons procname nil) ess-process-name-list))))
(ess-make-buffer-current)
(goto-char (point-max))
(setq ess-sl-modtime-alist nil)
;; Add the process filter to catch certain output.
(set-process-filter (get-process procname)
'inferior-ess-output-filter)
;; (inferior-ess-wait-for-prompt)
(inferior-ess-mark-as-busy (get-process procname))
(process-send-string (get-process procname) "\n") ;; to be sure we catch the prompt if user comp is super-duper fast.
(unless no-wait
(ess-write-to-dribble-buffer "(inferior-ess: waiting for process to start (before hook)\n")
(ess-wait-for-process (get-process procname) nil 0.01))
;; arguments cache
(ess-process-put 'funargs-cache (make-hash-table :test 'equal))
(ess-process-put 'funargs-pre-cache nil)
;; set accumulation buffer name (buffer to cache output for faster display)
(process-put (get-process procname) 'accum-buffer-name
(format " *%s:accum*" procname))
;; don't font-lock strings over process prompt
(set (make-local-variable 'syntax-begin-function)
#'inferior-ess-goto-last-prompt-if-close)
(set (make-local-variable 'font-lock-fontify-region-function)
#'inferior-ess-fontify-region)
(run-hooks 'ess-post-run-hook)
;; EXTRAS
(ess-load-extras t)
;; user initialization can take some time ...
(unless no-wait
(ess-write-to-dribble-buffer "(inferior-ess 3): waiting for process after hook")
(ess-wait-for-process (get-process procname))))
(with-current-buffer buf
(rename-buffer buf-name-str t))
(if (and inferior-ess-same-window (not inferior-ess-own-frame))
(switch-to-buffer buf)
(pop-to-buffer buf)))))))
(defvar inferior-ess-objects-command nil
"The language/dialect specific command for listing objects.
It is initialized from the corresponding inferior-<lang>-objects-command
and then made buffer local."); and the *-<lang>-* ones are customized!
(make-variable-buffer-local 'inferior-ess-objects-command)
(defvar ess-save-lastvalue-command nil
"The command to save the last value. See S section for more details.
Default depends on the ESS language/dialect and hence made buffer local")
(make-variable-buffer-local 'ess-save-lastvalue-command)
(defvar ess-retr-lastvalue-command nil
"The command to retrieve the last value. See S section for more details.
Default depends on the ESS language/dialect and hence made buffer local")
(make-variable-buffer-local 'ess-retr-lastvalue-command)
;;; A note on multiple processes: the following variables
;;; ess-local-process-name
;;; ess-sl-modtime-alist
;;; ess-prev-load-dir/file
;;; ess-directory
;;; ess-object-list
;;; are specific to each ess-process and are buffer-local variables
;;; local to the ESS process buffer. If required, these variables should
;;; be accessed with the function ess-get-process-variable
(defun inferior-ess-goto-last-prompt-if-close ()
"If any prompt has been found on current line, go to previous primary prompt and return the position.
Otherwise stay at current position and return nil "
(let ((new-point (save-excursion
(beginning-of-line)
(if (looking-at inferior-ess-primary-prompt)
(point)
(when (and inferior-ess-secondary-prompt
(looking-at inferior-ess-secondary-prompt))
(re-search-backward (concat "^" inferior-ess-primary-prompt))
(point))))))
(when new-point
(goto-char new-point))))
(defvar compilation--parsed)
(defun inferior-ess-fontify-region (beg end &optional verbose)
"Fontify output by output within the beg-end region to avoid
fontification spilling over prompts."
(let* ((buffer-undo-list t)
(inhibit-point-motion-hooks t)
(font-lock-dont-widen t)
(buff (current-buffer))
(pos (or (inferior-ess-goto-last-prompt-if-close)
beg))
(pos2))
;; Font lock seems to skip regions for unlear reason when
;; font-lock-dont-widen is t. This in turn screws compilation marker and
;; makes compilation--parse-region think that it parsed stuff that it
;; didn't. So reset it each time.
(setq compilation--parsed -1)
(with-silent-modifications
;; (dbg pos end)
;; (font-lock-unfontify-region pos end)
(while (< pos end)
(goto-char pos)
(comint-next-prompt 1)
(setq pos2 (min (point) end))
(if nil
(font-lock-default-fontify-region pos pos2 verbose)
;; Some error locations are not fontified with with narrowing. Especiall those from gcc.
;; What on earth is goin on?
(save-restriction
(narrow-to-region pos pos2)
(font-lock-default-fontify-region pos pos2 verbose)))
(setq pos pos2)))))
(defun ess-gen-proc-buffer-name:simple (proc-name)
"Function to generate buffer name by wrapping PROC-NAME in *proc-name*"
(format "*%s*" proc-name))
(defun ess-gen-proc-buffer-name:directory (proc-name)
"Function to generate buffer name by wrapping PROC-NAME in
*proc-name:dir-name* where dir-name is a short directory name."
(format "*%s:%s*" proc-name (file-name-nondirectory
(directory-file-name default-directory))))
(defun ess-gen-proc-buffer-name:abbr-long-directory (proc-name)
"Function to generate buffer name by wrapping PROC-NAME in
*proc-name:abbreviated-long-dir-name*, where
abbreviated-long-dir-name is an abbreviated full directory name.
Abbreviation performed by `abbreviate-file-name'.
"
(format "*%s:%s*" proc-name (abbreviate-file-name default-directory)))
(defun inferior-ess-set-status (proc string &optional no-timestamp)
"Internal function to set the satus of the PROC
If no-timestamp, don't set the last-eval timestamp.
Return the 'busy state."
;; todo: do it in one search, use starting position, use prog1
(let ((busy (not (string-match (concat "\\(" inferior-ess-primary-prompt "\\)\\'") string))))
(process-put proc 'busy-end? (and (not busy)
(process-get proc 'busy)))
(when (not busy)
(process-put proc 'running-async? nil))
(process-put proc 'busy busy)
(process-put proc 'sec-prompt
(when inferior-ess-secondary-prompt
(string-match (concat "\\(" inferior-ess-secondary-prompt "\\)\\'") string)))
(unless no-timestamp
(process-put proc 'last-eval (current-time)))
busy))
(defun inferior-ess-mark-as-busy (proc)
(process-put proc 'busy t)
(process-put proc 'sec-prompt nil))
(defun inferior-ess-run-callback (proc string)
;; callback is stored in 'callbacks proc property. Callbacks is a list that
;; can contain either functions to be called with two artuments PROC and
;; STRING, or cons cells of the form (func . suppress). If SUPPRESS is non-nil
;; next process output will be suppressed.
(unless (process-get proc 'busy)
;; only one callback is implemented for now
(let* ((cb (car (process-get proc 'callbacks)))
(listp (not (functionp cb)))
(suppress (and listp (consp cb) (cdr cb)))
(cb (if (and listp (consp cb))
(car cb)
cb)))
(when cb
(when ess-verbose
(ess-write-to-dribble-buffer "executing callback ...\n"))
(when suppress
(process-put proc 'suppress-next-output? t))
(process-put proc 'callbacks nil)
(condition-case err
(funcall cb proc string)
(error (message "%s" (error-message-string err))))))))
(defun ess--if-verbose-write-process-state (proc string &optional filter)
(ess-if-verbose-write
(format "\n%s:
--> busy:%s busy-end:%s sec-prompt:%s interruptable:%s <--
--> running-async:%s callback:%s suppress-next-output:%s <--
--> dbg-active:%s is-recover:%s <--
--> string:%s\n"
(or filter "NORMAL-FILTER")
(process-get proc 'busy)
(process-get proc 'busy-end?)
(process-get proc 'sec-prompt)
(process-get proc 'interruptable?)
(process-get proc 'running-async?)
(if (process-get proc 'callbacks) "yes")
(process-get proc 'suppress-next-output?)
(process-get proc 'dbg-active)
(process-get proc 'is-recover)
(if (> (length string) 150)
(format "%s .... %s" (substring string 0 50) (substring string -50))
string))))
(defun inferior-ess-output-filter (proc string)
"Standard output filter for the inferior ESS process.
Ring Emacs bell if process output starts with an ASCII bell, and pass
the rest to `comint-output-filter'.
Taken from octave-mod.el."
(inferior-ess-set-status proc string)
(ess--if-verbose-write-process-state proc string)
(inferior-ess-run-callback proc string)
(if (process-get proc 'suppress-next-output?)
;; works only for surpressing short output, for time being is enough (for callbacks)
(process-put proc 'suppress-next-output? nil)
(comint-output-filter proc (inferior-ess-strip-ctrl-g string))
(ess--show-process-buffer-on-error string proc)))
(defun ess--show-process-buffer-on-error (string proc)
(let ((case-fold-search nil))
(when (string-match "Error\\(:\\| +in\\)" string)
(ess-show-buffer (process-buffer proc)))))
(defun inferior-ess-strip-ctrl-g (string)
"Strip leading `^G' character.
If STRING starts with a `^G', ring the Emacs bell and strip it.
Depending on the value of `visible-bell', either the frame will
flash or you'll hear a beep. Taken from octave-mod.el."
(if (string-match "^\a" string)
(progn
(ding)
(setq string (substring string 1))))
string)
(defun ess-process-sentinel (proc message)
"Sentinel for use with ESS processes.
This marks the process with a message, at a particular time point."
(save-excursion
(setq message (substring message 0 -1)) ; strip newline
(set-buffer (process-buffer proc))
(comint-write-input-ring)
(goto-char (point-max))
(insert-before-markers
(format "\nProcess %s %s at %s\n"
(process-name proc) message (current-time-string)))))
(defun inferior-ess-make-comint (bufname
procname
infargs
&rest switches)
"Make an S comint process in buffer BUFNAME with process PROCNAME."
;;; This function is a modification of make-comint from the comint.el
;;; code of Olin Shivers.
(let* ((buffer (get-buffer-create bufname))
(proc (get-process procname)))
;; If no process, or nuked process, crank up a new one and put buffer in
;; comint mode. Otherwise, leave buffer and existing process alone.
(cond ((or (not proc) (not (memq (process-status proc) '(run stop))))
(with-current-buffer buffer
(if ess-directory (setq default-directory ess-directory))
(if (eq (buffer-size) 0) nil
(goto-char (point-max))
(insert "\^L\n"))) ; page boundaries = Interactive sessions
(let ((process-environment
(nconc
(list "STATATERM=emacs"
(format "PAGER=%s" inferior-ess-pager))
process-environment))
(tramp-remote-process-environment
(nconc ;; it contains a pager already, so append
(when (boundp 'tramp-remote-process-environment)
(copy-sequence tramp-remote-process-environment))
(list "STATATERM=emacs"
(format "PAGER=%s" inferior-ess-pager)))))
(ess-write-to-dribble-buffer "Making Process...")
(ess-write-to-dribble-buffer
(format "Buf %s, :Proc %s, :Prog %s\n :Args= %s\nStart File=%s\n"
buffer
procname
inferior-ess-program
infargs
inferior-ess-start-file))
(comint-exec buffer
procname
inferior-ess-program
inferior-ess-start-file
(ess-line-to-list-of-words
infargs)))))
buffer))
;;*;; Requester functions called at startup
(defun ess-get-directory (default dialect procname)
(let ((prog-version (cond ((string= dialect "R")
(concat ", " inferior-R-version)) ; notably for the R-X.Y versions
(inferior-ess-program
(concat ", " inferior-ess-program ))
(t ""))))
(ess-prompt-for-directory
(directory-file-name default)
(format "ESS (*%s*%s) starting data directory? "
procname prog-version)
;; (format "ESS [%s {%s(%s)}: '%s'] starting data directory? "
;; ;;FIXME: maybe rather tmp-dialect (+ evt drop ess-language?)?
;; procname ess-language ess-dialect prog-version)
)))
(defun ess-prompt-for-directory (default prompt)
"`prompt' for a directory, using `default' as the usual."
(let* ((def-dir (file-name-as-directory default))
(the-dir (expand-file-name
(file-name-as-directory
(read-directory-name prompt def-dir def-dir t nil)))))
(if (file-directory-p the-dir) nil
(error "%s is not a valid directory" the-dir))
the-dir))
;;*;; General process handling code
(defmacro with-ess-process-buffer (no-error &rest body)
"Execute BODY with current-buffer set to the process buffer of ess-current-process-name.
If NO-ERROR is t don't trigger error when there is not current
process.
Symbol *proc* is bound to the current process during the evaluation of BODY."
(declare (indent 1))
`(let ((*proc* (and ess-local-process-name (get-process ess-local-process-name))))
(if *proc*
(with-current-buffer (process-buffer *proc*)
,@body)
(unless ,no-error
(error "No current ESS process")))))
(defmacro ess-with-current-buffer (buffer &rest body)
"Like `with-current-buffer' but with transfer of some essential
local ESS vars like `ess-local-process-name'"
(declare (indent 1))
(let ((lpn (make-symbol "lpn"))
(alist (make-symbol "alist")))
`(let ((,lpn ess-local-process-name)
(,alist ess-local-customize-alist))
(with-current-buffer ,buffer
(ess-setq-vars-local (eval ,alist))
(setq ess-local-process-name ,lpn)
,@body))))
(dolist (mode '(emacs-lisp-mode lisp-interaction-mode))
(font-lock-add-keywords
mode
'(("(\\(ess-with-current-buffer\\)\\s +\\(\\(\\w\\|\\s_\\)+\\)"
(1 font-lock-keyword-face)
(2 font-lock-variable-name-face)))))
(defun ess-get-process (&optional name use-another)
"Return the ESS process named by NAME. If USE-ANOTHER is non-nil,
and the process NAME is not running (anymore), try to connect to another if
there is one. By default (USE-ANOTHER is nil), the connection to another
process happens interactively (when possible)."
(setq name (or name ess-local-process-name))
(if (null name) ; should almost never happen at this point
(error "No ESS process is associated with this buffer now"))
(update-ess-process-name-list)
(if (assoc name ess-process-name-list)
(get-process name)
;; else :
;; was (error "Process %s is not running" name)
(ess-write-to-dribble-buffer
(format "ess-get-process: process '%s' not running" name))
(if (= 0 (length ess-process-name-list))
(save-current-buffer
(ess-write-to-dribble-buffer
(format " .. restart proc %s for language %s (buf %s)\n"
name ess-language (current-buffer)))
(message "trying to (re)start process %s for language %s ..."
name ess-language)
(ess-start-process-specific ess-language ess-dialect)
;; and return the process: "call me again"
(ess-get-process name))
;; else: there are other running processes
(if use-another ; connect to another running process : the first one
(let ((other-name (car (elt ess-process-name-list 0))))
;; "FIXME": try to find the process name that matches *closest*
(message "associating with *other* process '%s'" other-name)
(ess-get-process other-name))
;; else
(ding)
(if (yes-or-no-p
(format "Process %s is not running, but others are. Switch? " name))
(progn
(ess-force-buffer-current
(concat ess-dialect " process to use: ") 'force)
(ess-get-process ess-current-process-name))
(error "Process %s is not running" name))))))
;; (defun inferior-ess-wait-for-prompt ()
;; "Wait until the ESS process is ready for input."
;; (let* ((cbuffer (current-buffer))
;; (sprocess (ess-get-process ess-current-process-name))
;; (sbuffer (process-buffer sprocess))
;; (r nil)
;; (timeout 0))
;; (set-buffer sbuffer)
;; (while (progn
;; (if (not (eq (process-status sprocess) 'run))
;; (ess-error "ESS process has died unexpectedly.")
;; (if (> (setq timeout (1+ timeout)) ess-loop-timeout)
;; (ess-error "Timeout waiting for prompt. Check inferior-ess-prompt or ess-loop-timeout."))
;; (accept-process-output)
;; (goto-char (point-max))
;; (beginning-of-line); bol ==> no need for "^" in *-prompt! (MM?)
;; ;; above, except for Stata, which has "broken" i/o,
;; ;; sigh... (AJR)
;; (setq r (looking-at inferior-ess-prompt))
;; (not (or r (looking-at ".*\\?\\s *"))))))
;; (goto-char (point-max))
;; (set-buffer cbuffer)
;; (symbol-value r)))
;;--- Unfinished idea (ESS-help / R-help ) -- probably not worth it...
;;- (defun ess-set-inferior-program-name (filename)
;;- "Allows to set or change `inferior-ess-program', the program (file)name."
;;- (interactive "fR executable (script) file: ")
;;- ;; "f" : existing file {file name completion} !
;;- (setq inferior-ess-program filename))
;; the inferior-ess-program is initialized in the customize..alist,
;; e.g. from inferior-R-program-name ... --> should change rather these.
;; However these really depend on the current ess-language!
;; Plan: 1) must know and use ess-language
;; 2) change the appropriate inferior-<ESSlang>-program-name
;; (how?) in R/S : assign(paste("inferior-",ESSlang,"-p...."), filename))
;;*;; Multiple process handling code
(defun ess-make-buffer-current nil
"Make the process associated with the current buffer the current ESS process.
Returns the name of the process, or nil if the current buffer has none."
(update-ess-process-name-list)
;; (if ess-local-process-name
;; (setq ess-current-process-name ess-local-process-name))
ess-local-process-name)
(defun ess-get-process-variable (var)
"Return the variable VAR (symbol) local to ESS process called NAME (string)."
(buffer-local-value var (process-buffer (ess-get-process ess-local-process-name))))
(defun ess-set-process-variable (var val)
"Set variable VAR (symbol) local to ESS process called NAME (string) to VAL."
(with-current-buffer (process-buffer (ess-get-process ess-local-process-name))
(set var val)))
;; emacs 23 compatibility
(unless (fboundp 'process-live-p)
(defun process-live-p (process)
"Returns non-nil if PROCESS is alive.
A process is considered alive if its status is `run', `open',
`listen', `connect' or `stop'."
(memq (process-status process)
'(run open listen connect stop))))
(defun ess-process-live-p ()
"Check if the local ess process is alive.
Return nil if current buffer has no associated process, or
process was killed."
(and ess-local-process-name
(let ((proc (get-process ess-local-process-name)))
(and (processp proc)
(process-live-p proc)))))
(defun ess-process-get (propname)
"Return the variable PROPNAME (symbol) from the plist of the
current ESS process."
(process-get (get-process ess-local-process-name) propname))
(defun ess-process-put (propname value)
"Set the variable PROPNAME (symbol) to VALUE in the plist of
the current ESS process."
(process-put (get-process ess-local-process-name) propname value))
(defun ess-start-process-specific (language dialect)
"Start an ESS process typically from a language-specific buffer, using
LANGUAGE (and DIALECT)."
(unless dialect
(error "The value of `dialect' is nil"))
(save-current-buffer
(let ((dsymb (intern dialect)))
(ess-write-to-dribble-buffer
(format " ..start-process-specific: lang:dialect= %s:%s, current-buf=%s\n"
language dialect (current-buffer)))
(cond ;; ((string= dialect "R") (R))
;; ((string= language "S") ;
;; (message "ESS process not running, trying to start R, since language = 'S")
;; (R))
;; ((string= dialect STA-dialect-name) (stata))
;;general case
((fboundp dsymb)
(funcall dsymb))
(t ;; else: ess-dialect is not a function
;; Typically triggered from
;; ess-force-buffer-current("Process to load into: ")
;; \--> ess-request-a-process("Process to load into: " no-switch)
(error "No ESS processes running; not yet implemented to start (%s,%s)"
language dialect)))
;; save excursion is not working here !!! bad bad bad !!
)))
(defun ess-request-a-process (message &optional noswitch ask-if-1)
"Ask for a process, and make it the current ESS process.
If there is exactly one process, only ask if ASK-IF-1 is non-nil.
Also switches to the process buffer unless NOSWITCH is non-nil. Interactively,
NOSWITCH can be set by giving a prefix argument.
Returns the name of the selected process."
(interactive
(list "Switch to which ESS process? " current-prefix-arg))
; prefix sets 'noswitch
(ess-write-to-dribble-buffer "ess-request-a-process: {beginning}\n")
(update-ess-process-name-list)
(setq ess-dialect
(or ess-dialect (ess-completing-read
"Set `ess-dialect'"
(delete-dups (list "R" "S+" S+-dialect-name
"stata" STA-dialect-name
"julia" "SAS" "XLS" "ViSta")))))
(let* ((pname-list (delq nil ;; keep only those mathing dialect
(append
(mapcar (lambda (lproc)
(and (equal ess-dialect
(buffer-local-value
'ess-dialect
(process-buffer (get-process (car lproc)))))
(not (equal ess-local-process-name (car lproc)))
(car lproc)))
ess-process-name-list)
;; append local only if running
(when (assoc ess-local-process-name ess-process-name-list)
(list ess-local-process-name)))))
(num-processes (length pname-list))
(inferior-ess-same-window nil) ;; this should produce the inferior process in other window
(auto-started?))
(if (or (= 0 num-processes)
(and (= 1 num-processes)
(not (equal ess-dialect ;; don't auto connect if from different dialect
(buffer-local-value
'ess-dialect
(process-buffer (get-process
(car pname-list))))))))
;; try to start "the appropriate" process
(progn
(ess-write-to-dribble-buffer
(concat " ... request-a-process:\n "
(format
"major mode %s; current buff: %s; ess-language: %s, ess-dialect: %s\n"
major-mode (current-buffer) ess-language ess-dialect)))
(ess-start-process-specific ess-language ess-dialect)
(ess-write-to-dribble-buffer
(format " ... request-a-process: buf=%s\n" (current-buffer)))
(setq num-processes 1
pname-list (car ess-process-name-list)
auto-started? t)))
;; now num-processes >= 1 :
(let* ((proc-buffers (mapcar (lambda (lproc)
(buffer-name (process-buffer (get-process lproc))))
pname-list))
(proc
(if (or auto-started?
(and (not ask-if-1) (= 1 num-processes)))
(progn
(message "using process '%s'" (car proc-buffers))
(car pname-list))
;; else
(unless (and ess-current-process-name
(get-process ess-current-process-name))
(setq ess-current-process-name nil))
(when message
(setq message (replace-regexp-in-string ": +\\'" "" message))) ;; <- why is this here??
;; ask for buffer name not the *real* process name:
(let ((buf (ess-completing-read message (append proc-buffers (list "*new*")) nil t nil nil)))
(if (equal buf "*new*")
(progn
(ess-start-process-specific ess-language ess-dialect) ;; switches to proc-buff
(caar ess-process-name-list))
(process-name (get-buffer-process buf))
))
)))
(if noswitch
(pop-to-buffer (current-buffer)) ;; VS: this is weired, but is necessary
(pop-to-buffer (buffer-name (process-buffer (get-process proc))) t))
proc)))
(defun ess-force-buffer-current (&optional prompt force no-autostart ask-if-1)
"Make sure the current buffer is attached to an ESS process.
If not, or FORCE (prefix argument) is non-nil, prompt for a
process name with PROMPT. If NO-AUTOSTART is nil starts the new
process if process associated with current buffer has
died. `ess-local-process-name' is set to the name of the process
selected. `ess-dialect' is set to the dialect associated with
the process selected. ASK-IF-1 asks user for the process, even if
there is only one process running."
(interactive
(list (concat ess-dialect " process to use: ") current-prefix-arg nil))
;; fixme: why the above interactive is not working in emacs 24?
(setq prompt (or prompt "Process to use: "))
(let ((proc-name (ess-make-buffer-current)))
(if (and (not force) proc-name (get-process proc-name))
nil ; do nothing
;; Make sure the source buffer is attached to a process
(if (and ess-local-process-name (not force) no-autostart)
(error "Process %s has died" ess-local-process-name)
;; ess-local-process-name is nil -- which process to attach to
(let ((proc (ess-request-a-process prompt 'no-switch ask-if-1))
temp-ess-help-filetype dialect)
(with-current-buffer (process-buffer (get-process proc))
(setq temp-ess-help-filetype inferior-ess-help-filetype))
(setq ess-local-process-name proc)
(setq inferior-ess-help-filetype temp-ess-help-filetype)
)))))
(defun ess-switch-process ()
"Force a switch to a new underlying process."
(interactive)
(ess-force-buffer-current "Process to use: " 'force nil 'ask-if-1))
(defun ess-get-next-available-process (&optional dialect ignore-busy)
"Return first available (aka not busy) process of dialect DIALECT.
DIALECT defaults to the local value of ess-dialect. Return nil if
no such process has been found."
(setq dialect (or dialect ess-dialect))
(when dialect
(let (proc)
(catch 'found
(dolist (p (cons ess-local-process-name
(mapcar 'car ess-process-name-list)))
(when p
(setq proc (get-process p))
(when (and proc
(process-live-p proc)
(equal dialect
(buffer-local-value 'ess-dialect (process-buffer proc)))
(or ignore-busy
(not (process-get proc 'busy))))
(throw 'found proc))))))))
;;*;;; Commands for switching to the process buffer
(defun ess-switch-to-ESS (eob-p)
"Switch to the current inferior ESS process buffer.
With (prefix) EOB-P non-nil, positions cursor at end of buffer.
This function should follow the description in `ess-show-buffer'
for showing the iESS buffer, except that the iESS buffer is also
made current."
(interactive "P")
(ess-force-buffer-current)
(if (and ess-current-process-name (get-process ess-current-process-name))
(progn
;; Display the buffer, but don't select it yet.
(ess-show-buffer
(buffer-name (process-buffer (get-process ess-current-process-name)))
t)
(if eob-p (goto-char (point-max))))
(message "No inferior ESS process")
(ding)))
(defun ess-switch-to-ESS-deprecated (eob-p)
(interactive "P")
(ess-switch-to-ESS eob-p)
(message "C-c C-y is deprecated, use C-c C-z instead (ess-switch-to-inferior-or-script-buffer)"))
(defun ess-switch-to-end-of-ESS ()
"Switch to the end of the inferior ESS process buffer."
(interactive)
(ess-switch-to-ESS t))
(defun ess-switch-to-inferior-or-script-buffer (toggle-eob)
"If in script, switch to the iESS. If in iESS switch to most recent script buffer.
This is a single-key command. Assuming that it is bound to C-c C-z,
you can navigate back and forth between iESS and script buffer
with C-c C-z C-z C-z ...
If variable `ess-switch-to-end-of-proc-buffer' is t (the default)
this function switches to the end of process buffer.
If TOGGLE-EOB is given, the value of
`ess-switch-to-end-of-proc-buffer' is toggled.
"
(interactive "P")
(let ((map (make-sparse-keymap))
(EOB (if toggle-eob
(not ess-switch-to-end-of-proc-buffer)
ess-switch-to-end-of-proc-buffer)))
(define-key map (vector last-command-event)
(lambda (ev eob) (interactive)
(if (not (eq major-mode 'inferior-ess-mode))
(ess-switch-to-ESS eob)
(let ((dialect ess-dialect)
(loc-proc-name ess-local-process-name)
(blist (cdr (buffer-list))))
(while (and blist
(with-current-buffer (car blist)