forked from roadrunner1776/magik
-
Notifications
You must be signed in to change notification settings - Fork 0
/
magik-session.el
executable file
·1624 lines (1439 loc) · 70.3 KB
/
magik-session.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
;;; magik-session.el --- mode for running a Smallworld Magik interactive process
;; This program 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 3 of the License, or
;; (at your option) any later version.
;; This program 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.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; The filter for the magik shell process is in magik-session-filter.el
;;
;; This is a new version of the gis-mode that uses a vector of marker
;; pairs rather than a list. This allows us to move up and down the
;; array efficiently and also use things like binary search.
;;
;; Every hundred commands, a new bigger vector is created and the
;; invalid or degenerate previous commands are cleaned out - previous
;; commands are counted as degenerate if they point at a non-existent
;; buffer (cos the user killed the buffer and created a new one) or
;; have length zero (cos the user deleted the text the the markers
;; bounded).
;;
;; Unlike previous versions, the markers will mark the whole of the
;; text sent to the gis, including the dollar and the return.
;;
;; Note that all previous commands need to be kept, not just the last
;; 20 or so because the markers are the only way we can know what the
;; commands were - looking for prompts and dollars is too unreliable.
;;
;; Unlike shell-mode, we don't keep comint-last-input-start and
;; comint-last-input-end. (??? I've changed last-input-* to
;; comint-last-input-* everywhere. I hope this still works!)
;;
;; The previous commands are kept in a buffer local variable called
;; magik-session-prev-cmds.
;;
;; Where possible, we try to allow more than one gis to be running.
;; This gets a bit tricky for things like transmit-method-to-magik
;; because they have to know where to send the magik to. In order to
;; simplify this, we are getting rid of the variable,
;; magik-process-name, because it is a duplicate of magik-session-buffer. We
;; also don't ever refer to the process by its name but always by its
;; buffer - this should save any confusion with gis process naming.
;;
;; We don't rely on the form of the prompt any more. We just rely on
;; it ending in a space. The only place where we need to be sure is in
;; the filter.
;;
;; In this version of magik-session-mode, we don't have any automatic
;; indentation of magik-code. The tab is just for inserting tabs and
;; nothing else.
;;
;; During a sequence of M-p and M-n commands, the actual command
;; we're looking at is recorded in the buffer-local variable,
;; magik-session-cmd-num.
;;
;; Unlike direct-gis-mode.el we keep the oldest command at the front.
;; This is fine because we can get to the end of a vector quickly.
;; We record how many commands are in our vector in the buffer-local
;; variable, magik-session-no-of-cmds. To get rid of annoying edge
;; effects in going up and down the vector, we keep a pair of markers
;; that bound an empty bit of text at the end of the vector.
;;
;; Arbitrary decision: if a command is recalled by grabbing it with
;; the RET key, the magik-session-cmd-num is set to 0 (as if it had been
;; typed by hand) rather than the number of the command that was
;; recalled.
;;; Code:
(eval-when-compile
(require 'comint)
(defvar comint-last-input-start)
(defvar comint-last-input-end)
(defvar msb-menu-cond))
(require 'magik-mode)
(require 'magik-electric)
(require 'magik-indent)
(require 'magik-pragma)
(or (boundp 'ac-sources) (setq ac-sources nil))
(defcustom magik-session-buffer nil
"*The default Smallworld session.
Used for switching to the first Smallworld session."
:group 'magik
:type '(choice string (const nil)))
(defcustom magik-session-buffer-default-name "*gis*"
"*The default name of a Gis process buffer when creating new Smallworld sessions."
:group 'magik
:type 'string)
(defcustom magik-session-prompt nil
"String or Regular expression identifing the default Magik Prompt.
If global value is nil, a GIS session will attempt to discover the current
setting of the Magik Prompt by calling `magik-session-prompt-get'."
:group 'magik
:type '(choice regexp (const nil)))
; paulw - preset rather than allow discovery (which doesn't seem to work)
(setq magik-session-prompt "Magik\\(\\|SF\\)> ")
(defcustom magik-session-command-history-max-length 90
"*The maximum length of the displayed `magik-session-command' in the Magik Session -> Magik Session Command History submenu.
`magik-session-command' is a string of the form \"[DIRECTORY] COMMAND ARGS\"."
:group 'magik
:type 'integer)
(defcustom magik-session-command-history-max-length-dir (floor (/ magik-session-command-history-max-length 2))
"*The maximum length of the displayed directory path in the Magik Session -> Magik Session Command History submenu."
:group 'magik
:type 'integer)
(defcustom magik-session-recall-cmd-move-to-end nil
"*If t, move the cursor point to the end of the recalled command.
This behaviour is available for \\[magik-session-recall-prev-cmd] and \\[magik-session-recall-next-cmd] only.
The default is nil, which preserves the original behaviour to leave
the cursor point in the same position.
The similar commands, \\[magik-session-recall-prev-matching-cmd] and \\[magik-session-recall-next-matching-cmd]
that use command string matching are not affected by this setting."
:group 'magik
:type 'boolean)
(defcustom magik-session-font-lock-prompt-face 'font-lock-type-face
"*Font-lock Face to use when displaying the Magik Prompt."
:group 'magik
:type 'face)
(defcustom magik-session-font-lock-error-face 'font-lock-warning-face
"*Font-lock Face to use when displaying Error lines."
:group 'magik
:type 'face)
(defcustom magik-session-font-lock-traceback-face 'font-lock-warning-face
"*Font-lock Face to use when displaying Traceback lines."
:group 'magik
:type 'face)
(defcustom magik-session-font-lock-keywords
(append
magik-font-lock-keywords-1
magik-font-lock-keywords-2
(list
'("^\\*\\*\\*\\* Error:.*$" 0 magik-session-font-lock-error-face t)
'("^\\*\\*\\*\\* Warning:.*$" 0 font-lock-warning-face t)
'("^---- traceback.* ----" . magik-session-font-lock-traceback-face)
'("^@.*$" . font-lock-reference-face)
;;magik-session-prompt entries are handled by magik-session-filter-set-gis-prompt-action
))
"Additional expressions to highlight in GIS mode."
:type 'sexp
:group 'magik)
(defcustom magik-session-start-process-pre-hook nil
"*Hook run before starting the process."
:type 'hook
:group 'magik)
(defcustom magik-session-start-process-post-hook nil
"*Hook run after starting the process."
:type 'hook
:group 'magik)
(defcustom magik-session-auto-insert-dollar nil
"Controls whether gis mode automatically inserts a $ after each valid magik statement."
:group 'magik
:type 'boolean)
(defcustom magik-session-sentinel-hooks nil
"*Hooks to run after the gis process has finished.
Each hook is passed the exit status of the gis process."
:type 'hook
:group 'magik)
(defcustom magik-session-drag-n-drop-mode nil
"Variable storing setting of \\[magik-session-drag-n-drop-mode].
To make this mode operate on a per-buffer basis, simply make
this variable buffer-local by putting the following in your .emacs
(defvar magik-session-mode-hook nil)
(defun magik-session-drag-n-drop-mode-per-buffer ()
(set (make-local-variable 'magik-session-drag-n-drop-mode) magik-session-drag-n-drop-mode))
(add-hook 'magik-session-mode-hook 'magik-session-drag-n-drop-mode-per-buffer)
"
;;Use of integers is a standard way of forcing minor modes on and off.
:type '(choice (const :tag "On" 1)
(const :tag "Off" -1))
:group 'magik)
(defvar magik-session-buffer-alist nil
"Alist storing GIS buffer name and number used for prefix key switching.")
(defvar magik-session-drag-n-drop-mode-line-string nil
"Mode-line string to use for Drag 'n' Drop mode.")
(defvar magik-session-filter-state nil
"State variable for the filter function.")
(defvar magik-session-process nil
"The process object of the command running in the buffer.")
(defvar magik-session-current-command nil
"The current `magik-session-command' in the current buffer.")
(defvar magik-session-exec-path nil
"Stored value of `exec-path' when the GIS process was started.")
(make-variable-buffer-local 'magik-session-exec-path)
(defvar magik-session-process-environment nil
"Stored value of `process-environment' when the GIS process was started.")
(make-variable-buffer-local 'magik-session-process-environment)
(defvar magik-session-cb-buffer nil
"The Class browser buffer associated with the GIS process.")
(defvar magik-session-no-of-cmds nil
"No. of commands we have sent to this buffer's gis including the
null one at the end, but excluding commands that have been spotted as
being degenerate.")
(defvar magik-session-cmd-num nil
"A number telling us what command is being recalled. Important for
M-p and M-n commands. The first command typed is number 0. The
current command being typed is number (1- magik-session-no-of-cmds).")
(defvar magik-session-prev-cmds nil
"A vector of pairs of markers, oldest commands first. Every time
the vector fills up, we copy to a new vector and clean out naff
markers.")
(defvar magik-session-history-length 20
"The default number of commands to fold.")
(defvar magik-session-command-syntax-table nil
"Syntax table in use for parsing quotes in magik-session-command.")
;; Create the syntax table
(if magik-session-command-syntax-table
()
(setq magik-session-command-syntax-table (make-syntax-table))
;; Allow embedded environment variables in Windows %% and Unix $ or ${} formats
(modify-syntax-entry ?$ "w" magik-session-command-syntax-table)
(modify-syntax-entry ?\{ "w" magik-session-command-syntax-table)
(modify-syntax-entry ?\} "w" magik-session-command-syntax-table)
(modify-syntax-entry ?% "w" magik-session-command-syntax-table)
(modify-syntax-entry ?_ "w" magik-session-command-syntax-table) ;make _ a word character for environment variable sustitution
(modify-syntax-entry ?\' "\"" magik-session-command-syntax-table) ;count single quotes as a true quote
(modify-syntax-entry ?\" "\"" magik-session-command-syntax-table) ;count double quotes as a true quote
(modify-syntax-entry ?\\ "\\" magik-session-command-syntax-table) ;allow a \ as an escape character
(modify-syntax-entry ?. "w" magik-session-command-syntax-table) ;(for filenames)
;; Special characters for Windows filenames
(modify-syntax-entry ?: "w" magik-session-command-syntax-table)
(modify-syntax-entry ?~ "w" magik-session-command-syntax-table) ;(mainly for NT 8.3 filenames)
)
(defconst magik-session-command-default "[%HOME%] %SMALLWORLD_GIS%/bin/x86/runalias.exe swaf_mega"
"The default value for magik-session-command.
It illustrates how Environment variables can be embedded in the command.
Also it neatly shows the three ways of referencing Environment variables,
via the Windows and Unix forms: %%, $ and ${}. All of which are
expanded irrespective of the current Operating System.")
;;Although still settable by the user via M-x set-variable,
;;it is preferred that magik-session-comand-history be used instead.
(defvar magik-session-command magik-session-command-default
"*The command used to invoke the gis. It is offered as the default
string for next time.")
(defcustom magik-session-command-history nil
"*List of commands run by a GIS buffer."
:group 'magik
:type '(choice (const nil)
(repeat string)))
(put 'magik-session-command-history 'permanent-local t)
(defcustom magik-session-kill-process-function 'magik-utils-delete-process-safely
"*The function used to terminate a Magik PROCESS in the GIS buffer.
`kill-process' terminates the process but the process may tidy itself up
before exiting and so Emacs will not display the terminated
process message in the buffer until that is complete.
`delete-process' terminates the process and Emacs immediately displays the
process terminated message.
`quit-process' Sends SIGQUIT signal if the OS implements it.
Not implemented on Windows OSes."
:group 'magik
:type 'function)
(defun magik-session-customize ()
"Open Customization buffer for Magik Session Mode."
(interactive)
(customize-group 'gis))
(defun magik-session-prompt-update-font-lock ()
"Update the Font-lock variable `magik-session-font-lock-keywords' with current `magik-session-prompt' setting."
(let ((entry (list (concat "^" magik-session-prompt) 0 magik-session-font-lock-prompt-face t)))
(if (member entry magik-session-font-lock-keywords)
nil ;; Already entered
(setq magik-session-font-lock-keywords (append magik-session-font-lock-keywords (list entry)))
(if (fboundp 'font-lock-set-defaults)
(progn ;; Emacs 20 and later font-lock mode post-process its variables
(set 'font-lock-set-defaults nil)
(funcall 'font-lock-set-defaults))))))
(defun magik-session-prompt-get (&optional force-query-p)
"If `magik-session-prompt' is nil, get the GIS session's command line prompt.
If interactive and a prefix arg is used then GIS session will be
queried irrespective of default value of `magik-session-prompt'"
(interactive "P")
(if (and (null force-query-p)
(stringp (default-value 'magik-session-prompt))) ;user has overridden setting
(progn
(compat-call setq-local magik-session-prompt (or magik-session-prompt ;user may have set a local value for it
(default-value 'magik-session-prompt)))
(magik-session-prompt-update-font-lock))
(process-send-string
magik-session-process
"_block
!terminal!.put(%x.from_value(1))
!terminal!.put(%P)
_if magik_rep.responds_to?(:prompt_generator)
_then !terminal!.write(magik_rep.prompt_generator.invoke(\"MagikSF> \"))
_else !terminal!.write(\"Magik\\(SF\\|2\\)> \")
_endif
!terminal!.put(%x.from_value(5))
!terminal!.put(%space)
_endblock\n$\n")))
(add-hook 'magik-session-start-process-post-hook 'magik-session-prompt-get)
(defun magik-session-shell ()
"Start a command shell with the same environment as the current GIS process."
(interactive)
(require 'shell)
(let ((process-environment (cl-copy-list magik-session-process-environment))
(exec-path (cl-copy-list magik-session-exec-path))
(buffer (concat "*shell*" (buffer-name)))
(version (and (boundp 'magik-session-version-current) (symbol-value 'magik-session-version-current))))
(make-comint-in-buffer "magik-session-shell"
buffer
(executable-find "cmd") nil "/k"
(concat (getenv "SMALLWORLD_GIS") "\\config\\environment.bat"))
(with-current-buffer buffer
(if (stringp version) (set 'magik-session-version-current version)))
(display-buffer buffer)))
(defun magik-session-parse-gis-command (command)
"Parse the magik-session-command string taking care of any quoting
and return a list of all the components of the command."
;;Copy the string into a temp buffer.
;;Use the Emacs sexp code and an appropriate syntax-table 'magik-session-command-syntax-table'
;;to cope with quotes and possible escaped quotes.
;;forward-sexp therefore guarantees preservation of white within quoted regions.
;;However, I do some extra work to try and remove the surrounding quotes from the returned result
(let ((temp-buf (get-buffer-create " *magik-session-command parser*"))
(command-list))
(save-excursion
(save-match-data
(set-buffer temp-buf)
(erase-buffer)
(set-syntax-table magik-session-command-syntax-table)
(insert command)
;Remove excess trailing whitespace to avoid spurious extra empty arguments being passed
(goto-char (point-max))
(delete-horizontal-space)
(goto-char (point-min))
(condition-case var
(setq command-list
(cl-loop
with start-char ;point containing valid word character - not whitespace or a quote
with substr ;substring containing command-line argument
do (progn
(setq start-char
(save-excursion
(skip-chars-forward " \t") ;skip intervening white space
(and (looking-at "[\"\']") (forward-char 1)) ;strip begin-quote
(point)))
(forward-sexp)
(setq substr (buffer-substring start-char (point)))
(if (string-match "[\"\']$" substr) ;strip end-quote if any
(setq substr (substring substr 0 (match-beginning 0))))
;Now look for embeded environment variables
(setq substr (substitute-in-file-name substr)))
collect substr
until (eobp)))
(scan-error
(error "%s or quotes" (cadr var)))))
(kill-buffer temp-buf)
command-list)))
(defun magik-session-buffer-alist-remove ()
"Remove current buffer from `magik-session-buffer-alist'."
(let ((c (rassoc (buffer-name) magik-session-buffer-alist)))
(if c
(progn
(setcdr c nil)
(car c)))))
(defun magik-session-buffer-alist-prefix-function (arg mode predicate)
"Function to process prefix keys when used with \\[gis]."
(let ((buf (cdr (assq arg magik-session-buffer-alist))))
(if (and buf
(with-current-buffer buf
(magik-utils-buffer-mode-list-predicate-p predicate)))
t
(error "No GIS buffer"))
buf))
(defun magik-session-command-display (command)
"Return shortened Gis command suitable for display."
(if (stringp command) ; defensive programming. Should be a string but need to avoid errors
(let ; because this function is called in a menu-update-hook
((command-len (- (min (length command) magik-session-command-history-max-length)))
(label ""))
(save-match-data
(if (string-match "^\\[[^\]]*\\]" command)
(setq label
(concat (magik-utils-file-name-display (match-string 0 command)
magik-session-command-history-max-length-dir)
"..."))))
(concat label (substring command (+ command-len (length label)))))))
(defun magik-session-update-tools-magik-gis-menu ()
"Update Magik Session processes submenu in Tools -> Magik pulldown menu."
(let* ((magik-session-alist (sort (copy-alist magik-session-buffer-alist)
#'(lambda (a b) (< (car a) (car b)))))
magik-session-list)
(dolist (c magik-session-alist)
(let ((i (car c))
(buf (cdr c)))
(if buf
(setq magik-session-list
(append magik-session-list
(list (vector buf
(list 'display-buffer buf)
':active t
':keys (format "M-%d f2 z" i))))))))
;;GIS buffers ordered according to when they were started.
;;killed session numbers are reused.
(easy-menu-change (list "Tools" "Magik")
"Magik Session Processes"
(or magik-session-list (list "No Processes")))))
(defun magik-session-update-magik-session-menu ()
"Update the Magik Session Command history in the Magik Session pulldown menu"
(if (eq major-mode 'magik-session-mode)
(let (command-list)
(save-match-data
;;Delete duplicates from magik-session-command-history local and global values
;;Note: delete-duplicates does not appear to work on localised variables.
(compat-call setq-local magik-session-command-history (cl-remove-duplicates magik-session-command-history :test 'equal))
(setq-default magik-session-command-history
(cl-remove-duplicates (default-value 'magik-session-command-history)
:test 'equal))
(dolist (command magik-session-command-history)
(push (apply
'vector
(magik-session-command-display command)
(list 'gis (buffer-name) (purecopy command))
':active
'(not (get-buffer-process (buffer-name)))
;; ':key-sequence nil
(list ':help (purecopy command)))
command-list)))
(if (get-buffer-process (buffer-name))
(setq command-list
(append command-list
(list "---"
(apply 'vector (magik-session-command-display magik-session-current-command)
'ignore ':active nil (list ':key-sequence nil
':help (purecopy magik-session-current-command)))
(apply 'vector "Start New Magik Session" 'magik-session-new-buffer
':active t
':keys '("C-u f2 z"))))))
(easy-menu-change (list "Magik Session")
"Magik Session Command History"
(or command-list (list "No History"))))))
(defun magik-session-update-tools-magik-shell-menu ()
"Update External Shell Processes submenu in Tools -> Magik pulldown menu."
(let ((shell-bufs (magik-utils-buffer-mode-list 'shell-mode
(function (lambda () (getenv "SMALLWORLD_GIS")))))
shell-list)
(cl-loop for buf in shell-bufs
do (push (vector buf (list 'display-buffer buf) t) shell-list))
(easy-menu-change (list "Tools" "Magik")
"External Shell Processes"
(or shell-list (list "No Processes")))))
(define-derived-mode magik-session-mode nil "Magik Session"
"Major mode to run a GIS as a direct subprocess.
The default name for a buffer running a GIS is \"*gis*\". The name of
the current GIS buffer is stored in the user option `magik-session-buffer`.
There are many ways to recall previous commands (see the online
help with \\[help-command]).
Commands are sent to the GIS with the F8 key or the return key.
Entry to this mode runs `magik-session-mode-hook`.
\\{magik-session-mode-map}"
:group 'magik
:syntax-table magik-base-mode-syntax-table
(let ((tmp-no-of-gis-cmds magik-session-no-of-cmds)
(tmp-gis-cmd-num magik-session-cmd-num)
(tmp-prev-gis-cmds magik-session-prev-cmds))
(compat-call setq-local
selective-display t
comint-last-input-start (make-marker)
comint-last-input-end (make-marker)
magik-session-command-history (or magik-session-command-history
(default-value 'magik-session-command-history))
magik-session-filter-state "\C-a"
magik-session-cb-buffer (concat "*cb*" (buffer-name))
magik-session-drag-n-drop-mode-line-string " DnD"
magik-transmit-debug-mode-line-string " #DEBUG"
show-trailing-whitespace nil
font-lock-defaults '(magik-session-font-lock-keywords nil t ((?_ . "w")))
ac-sources (append '(magik-ac-class-method-source
magik-ac-dynamic-source
magik-ac-global-source
magik-ac-object-source
magik-ac-raise-condition-source)
ac-sources)
magik-session-exec-path (cl-copy-list (or magik-session-exec-path exec-path))
magik-session-process-environment (cl-copy-list (or magik-session-process-environment process-environment))
mode-line-process '(": %s")
local-abbrev-table magik-base-mode-abbrev-table)
(if (null tmp-no-of-gis-cmds)
(progn
(compat-call setq-local
magik-session-no-of-cmds 1
magik-session-cmd-num 0
magik-session-prev-cmds (make-vector 100 nil))
(aset magik-session-prev-cmds 0 (let ((m (point-min-marker))) (cons m m))))
(compat-call setq-local
magik-session-no-of-cmds tmp-no-of-gis-cmds
magik-session-cmd-num tmp-gis-cmd-num
magik-session-prev-cmds tmp-prev-gis-cmds))
(unless (and magik-session-buffer (get-buffer magik-session-buffer))
(setq-default magik-session-buffer (buffer-name)))
(unless (rassoc (buffer-name) magik-session-buffer-alist)
(let ((n 1))
(while (cdr (assq n magik-session-buffer-alist))
(setq n (1+ n)))
(if (assq n magik-session-buffer-alist)
(setcdr (assq n magik-session-buffer-alist) (buffer-name))
(add-to-list 'magik-session-buffer-alist (cons n (buffer-name))))))
;; Special handling for *gis* buffer
(if (equal (buffer-name) "*gis*")
(compat-call setq-local
magik-session-exec-path (cl-copy-list exec-path)
magik-session-process-environment (cl-copy-list process-environment)))
(abbrev-mode 1)
(with-current-buffer (get-buffer-create (concat " *filter*" (buffer-name)))
(erase-buffer))
(add-hook 'menu-bar-update-hook 'magik-session-update-magik-session-menu nil t)
(add-hook 'menu-bar-update-hook 'magik-session-update-tools-magik-gis-menu nil t)
(add-hook 'menu-bar-update-hook 'magik-session-update-tools-magik-shell-menu nil t)
(add-hook 'kill-buffer-hook 'magik-session-buffer-alist-remove nil t)))
(defvar magik-session-menu nil
"Keymap for the Magik session buffer menu bar.")
(easy-menu-define magik-session-menu magik-session-mode-map
"Menu for Magik session mode."
`(,"Magik Session"
[,"Previous Command" magik-session-recall-prev-cmd t]
[,"Next Command" magik-session-recall-next-cmd t]
[,"Previous Matching Command" magik-session-recall-prev-matching-cmd t]
[,"Next Matching Command" magik-session-recall-next-matching-cmd t]
"----"
[,"Fold" magik-session-display-history :active t :keys "<f2> <up>, <f2> C-p"]
[,"Unfold" magik-session-undisplay-history :active t :keys "<f2> <down>, <f2> C-n"]
"----"
[,"Electric Template" magik-explicit-electric-space t]
[,"Symbol Complete" magik-symbol-complete t]
;; [,"Deep Print" magik-deep-print :active t :keys "<f2> x"]
"----"
[,"Previous Traceback" magik-session-traceback-up t]
[,"Next Traceback" magik-session-traceback-down t]
[,"Print Traceback" magik-session-traceback-print :active t :keys "<f4> P, <f2> ="]
[,"Save Traceback" magik-session-traceback-save t]
"----"
[,"External Shell Process" magik-session-shell t]
[,"Kill Magik Process" magik-session-kill-process (and magik-session-process
(eq (process-status magik-session-process) 'run))]
(,"Magik Session Command History")
"---"
(,"Toggle..."
[,"Magik Session Filter" magik-session-filter-toggle-filter :active t
:style toggle :selected (let ((b (get-buffer-process
(current-buffer))))
(and b (process-filter b)))]
[,"Drag and Drop" magik-session-drag-n-drop-mode :active t
:style toggle :selected magik-session-drag-n-drop-mode])
[,"Customize" magik-session-customize t]))
(defun magik-session-sentinel (proc msg)
"Sentinel function, runs when the magik process exits."
(let ((magik-session-exit-status (process-exit-status proc))
(buf (process-buffer proc)))
(with-current-buffer buf
;; ensure process end message is at end of buffer.
(goto-char (point-max))
(cond ((eq (process-status proc) 'exit)
(insert "\n\n" (format "Process %s %s"
(process-name proc)
msg)
"\n")
(message "Magik process %s exited: %s" buf msg))
((eq (process-status proc) 'signal)
(insert "\n\n" (format "Process %s %s"
(process-name proc)
msg)
"\n")
(message "Magik process %s signalled: %s" buf msg)))
(message "Magik process %s process %s has terminated with exit code: %s"
buf (process-name proc) (number-to-string magik-session-exit-status))
;;Allow messages to appear in *Messages* buffer
(sit-for 0.01)
(run-hook-with-args 'magik-session-sentinel-hooks magik-session-exit-status))))
(defun magik-session-start-process (args)
"Run a Gis process in the current buffer.
Adds `magik-session-current-command' to `magik-session-command-history' if not already there."
(run-hooks 'magik-session-start-process-pre-hook)
(or (member magik-session-current-command magik-session-command-history)
(add-to-list 'magik-session-command-history magik-session-current-command))
(compat-call setq-local magik-session-process (apply 'start-process "magik-session-process" (current-buffer) (car args) (cdr args)))
(set-process-sentinel magik-session-process 'magik-session-sentinel)
(set-marker (process-mark magik-session-process) (point-max))
(set-process-filter magik-session-process 'magik-session-filter)
;;MF New bit for connecting to the method finder:
;;MF We nuke the current cb first and reconnect later.
(when (and magik-cb-dynamic (get-buffer magik-session-cb-buffer))
(let ((magik-cb-process (get-buffer-process magik-session-cb-buffer)))
(if magik-cb-process (delete-process magik-cb-process)))
(process-send-string magik-session-process "_if method_finder _isnt _unset\n_then\n method_finder.lazy_start?\n method_finder.send_socket_to_emacs()\n_endif\n$\n"))
(sit-for 0.01)
(run-hooks 'magik-session-start-process-post-hook))
;; Put up here coz of load order problems.
;; The logic of the `F2 s' is still not quite right anyway.
;;;###autoload
(defun magik-session (&optional buffer command)
"Run a Gis process in a buffer in `magik-session-mode'.
The command is typically \"sw_magik_win32\" or \"sw_magik_motif\", but
can be any interactive program such as \"csh\".
The program that is offered as a default is stored in the variable,
`magik-session-command', which you can customise. e.g.
\(setq magik-session-command
\"[$HOME] sw_magik_win32 -Mextdir %TEMP% -image $SMALLWORLD_GIS/images/gis.msf\"
\)
The command automatically expands environment variables using
Windows %% and Unix $ and ${} nomenclature.
You can setup a list of standard commands by setting the
default value of `magik-session-command-history'.
Prefix argument controls:
With a numeric prefix arg, switch to the Gis process of that number
where the number indicates the order it was started. The
SW->Gis Processes indicates which numbers are in use. If a Gis process
buffer is killed, its number is reused when a new Gis process is started.
With a non-numeric prefix arg, ask user for buffer name to use for
GIS. This will default to a unique currently unused name based upon
the current value of `magik-session-buffer-default-name'.
If there is already a Gis process running in a visible window or
frame, just switch to that buffer, or prompt if more than one. If
there is not, prompt for a command to run, and then run it."
(interactive)
(if command (setq magik-session-command command))
(let (dir
cmd
args
;;read-string's history arg does not work with buffer-local variables
;;history also always has something see Package Registration at end
(command-history magik-session-command-history)
alias-beg
alias-expansion
(alias-buffer "*temp gis alias buffer*")
(keepgoing t)
(magik-session-start-process-pre-hook magik-session-start-process-pre-hook)
(buffer (magik-utils-get-buffer-mode (cond (buffer buffer)
((eq major-mode 'magik-session-mode) (buffer-name))
(t nil))
'magik-session-mode
"Enter Magik process buffer:"
(or magik-session-buffer magik-session-buffer-default-name)
'magik-session-buffer-alist-prefix-function
(generate-new-buffer-name magik-session-buffer-default-name)))
(rev-1920-regexp " +\\[rev\\(19\\|20\\)\\] +")
(alias-subst-regexp "\\\\!\\(\\\\\\)?\\*"))
(if (and (get-buffer-process buffer)
(eq (process-status (get-buffer-process buffer)) 'run))
(progn
(pop-to-buffer buffer)
(goto-char (point-max)))
;; Else start a fresh gis:
;; We keep going round expanding aliases until there is no alias expansion.
;; Each time round the user can edit the expanded alias.
;; We also silently remove any strings of the form [rev20] or [rev19].
(with-current-buffer (get-buffer-create alias-buffer)
(erase-buffer)
(if (and (equal (getenv "SHELL") "/bin/csh")
(file-readable-p "~/.alias"))
(insert-file-contents "~/.alias"))
(while keepgoing
(setq keepgoing nil)
(setq magik-session-command (sub magik-session-command rev-1920-regexp " "))
(or (eq (string-match "\\[" magik-session-command) 0)
(setq magik-session-command (concat "[" default-directory "] " magik-session-command)))
(or command
(setq magik-session-command
(read-string "Magik command: "
(car command-history)
'command-history)))
(if (string-match rev-1920-regexp magik-session-command)
(progn
(setq keepgoing t)
(setq magik-session-command (sub magik-session-command rev-1920-regexp " "))))
(or (eq (string-match "\\[" magik-session-command) 0)
(setq magik-session-command (concat "[" default-directory "] " magik-session-command)))
(string-match "\\[\\([^\]]*\\)\\] *\\([^ ]*\\) *\\(.*\\)" magik-session-command)
(setq dir (substring magik-session-command (match-beginning 1) (match-end 1)))
(setq cmd (substring magik-session-command (match-beginning 2) (match-end 2)))
(setq args (substring magik-session-command (match-beginning 3) (match-end 3)))
(goto-char (point-min))
(if (re-search-forward (concat "^alias[ \t]+" (regexp-quote cmd) "[ \t]+") nil t)
(progn
(setq keepgoing t)
(setq alias-beg (match-end 0))
(goto-char alias-beg)
(if (looking-at "['\"]")
(progn
(cl-incf alias-beg)
(end-of-line)
(re-search-backward "['\"]"))
(end-of-line))
(setq alias-expansion (buffer-substring alias-beg (point)))
(or (string-match alias-subst-regexp alias-expansion)
(setq alias-expansion (concat alias-expansion " \\!*")))
(setq alias-expansion (sub alias-expansion alias-subst-regexp args))
(setq magik-session-command (concat "[" dir "] " alias-expansion)))))
(kill-buffer alias-buffer))
(pop-to-buffer (get-buffer-create buffer))
(magik-session-mode)
(goto-char (point-max))
(insert "\n" (current-time-string) "\n")
(setq default-directory (expand-file-name
(file-name-as-directory
(substitute-in-file-name dir))))
(compat-call setq-local
magik-session-current-command (copy-sequence magik-session-command)
magik-session-command-history (cons magik-session-current-command
(delete magik-session-current-command magik-session-command-history)))
(setq-default magik-session-command-history (cons magik-session-current-command
(delete magik-session-current-command magik-session-command-history)))
(or (file-directory-p default-directory)
(error "Directory does not exist: %s" default-directory))
(add-hook 'magik-session-start-process-pre-hook
(function (lambda () (insert magik-session-command ?\n ?\n)))
t)
(magik-session-start-process (magik-session-parse-gis-command (concat cmd " " args))))))
(defun magik-session-new-buffer ()
"Start a new GIS session."
(interactive)
(let ((current-prefix-arg t))
(call-interactively 'gis)))
(defun magik-session-kill-process ()
"Kill the current gis process.
Uses `magik-session-kill-process-function' function to kill the process given in `magik-session-process'."
(interactive)
(if (and magik-session-process
(eq (process-status magik-session-process) 'run)
(y-or-n-p "Kill the Magik process? "))
(let ((status (process-status magik-session-process)))
(funcall magik-session-kill-process-function magik-session-process)
(sit-for 0.1)
(if (eq status (process-status magik-session-process))
(insert "\nMagik is still busy and will exit at an appropriate point. Please be patient... \n")))))
(defun magik-session-query-interrupt-shell-subjob ()
"Ask and then comint-interrupt-subjob."
(interactive)
(if (y-or-n-p "Kill the Magik process? ")
(comint-kill-subjob)))
(defun magik-session-query-quit-shell-subjob ()
"Ask and then comint-quit-subjob."
(interactive)
(if (y-or-n-p "Kill the Magik process? ")
(comint-quit-subjob)))
(defun magik-session-query-stop-shell-subjob ()
"Ask and then comint-stop-subjob."
(interactive)
(if (y-or-n-p "Suspend the Magik process? ")
(comint-stop-subjob)))
(defun magik-session-query-shell-send-eof ()
"Ask and then comint-send-eof."
(interactive)
(if (y-or-n-p "Send EOF to the Magik process? ")
(comint-send-eof)))
;; R E C A L L I N G C O M M A N D S
;; ___________________________________
;;
;;; Each gis command is recorded by vec-gis-mode.el so that the
;;; the user can recall and edit previous commands. This file
;;; also adds dollars and implements the history-folding feature.
(defun magik-session-copy-cmd (n offset)
"Copy command number N to the bottom of the buffer (replacing
any current command) and locate the cursor to an offset OFFSET."
(delete-region (process-mark (get-buffer-process (current-buffer))) (point-max))
(goto-char (point-max))
(let*
((pair (aref magik-session-prev-cmds n))
(str (subst-char-in-string ?\r ?\n (buffer-substring (car pair) (cdr pair))))
(len (length str)))
(insert str)
(forward-char (- (max 0 (min len offset)) len))
(if (pos-visible-in-window-p)
(while
(not (pos-visible-in-window-p (point-max)))
(scroll-up 1)))))
(defun magik-session-send-region (beg end)
"Record in `magik-session-prev-cmds' the region BEG to END and send to the gis.
Also update `magik-session-cmd-num'. Also append the string to \" *history**gis*\"."
(save-excursion
(let ((str (buffer-substring beg end)))
(set-buffer (get-buffer-create (concat " *history*" (buffer-name))))
(magik-mode)
(let ((orig-point (point)))
(goto-char (point-max))
(insert str "\n")
(goto-char orig-point))))
(let ((n magik-session-no-of-cmds))
(if (= n (length magik-session-prev-cmds))
(magik-session--make-new-cmds-vec))
(setq n magik-session-no-of-cmds) ;; aaargh! I had forgotten this line and had a horrible intermittent bug.
;; NB: we are keeping a null marker at the end and this must be moved along.
(aset magik-session-prev-cmds n (aref magik-session-prev-cmds (1- n)))
(aset magik-session-prev-cmds (1- n) (cons (copy-marker beg) (copy-marker end)))
(compat-call setq-local magik-session-cmd-num magik-session-no-of-cmds)
(cl-incf magik-session-no-of-cmds)
(set-marker comint-last-input-start beg)
(set-marker comint-last-input-end end)
(set-marker (process-mark (get-buffer-process (current-buffer))) end)
(goto-char (point-max))
(process-send-region (get-buffer-process (current-buffer)) beg end)))
(defun magik-session--make-new-cmds-vec ()
"Create a new bigger vector for `magik-session-prev-cmds' and copy the
non-degenerate commands into it."
(message "Resizing the command history vector...")
(let*
((len (length magik-session-prev-cmds))
(v (make-vector (+ len 100) nil))
(i 0)
(v_i 0))
(while
(< i len)
(let
((x (aref magik-session-prev-cmds i)))
(if (and (marker-buffer (car x))
(marker-buffer (cdr x))
(> (cdr x) (car x)))
(progn
(aset v v_i x)
(cl-incf v_i))))
(cl-incf i))
(let
((m (copy-marker (point-min))))
(aset v v_i (cons m m)))
(compat-call setq-local
magik-session-no-of-cmds (1+ v_i)
magik-session-prev-cmds v)
(message "Re-sizing the command history vector... Done. (%s commands)." (number-to-string v_i))))
(defun magik-session-beginning-of-line (&optional n)
"Move point to beginning of Nth line or just after prompt.
If command is repeated then place point at beginning of prompt."
(interactive "p")
(beginning-of-line n)
;;Only move to end of prompt if last-command was this one
;;AND a prefix key has not be used (n=1).
(and (not (and (eq last-command 'magik-session-beginning-of-line) (eq n 1)))
(looking-at magik-session-prompt)
(goto-char (match-end 0))))
; paulw - mods to make pre/post SW5 work in a single emacs
; see also swkeys.el for key definition
(defun magik-session-toggle-dollar ()
"Toggle auto-insertion of $ terminator"
(interactive )
(setq magik-session-auto-insert-dollar (not magik-session-auto-insert-dollar))
(if magik-session-auto-insert-dollar
(message "Insert dollar now enabled")
(message "Insert dollar now disabled")))
(defun magik-session-newline (arg)
"If in a prev. cmd., recall.
If within curr. cmd., insert a newline.
If at end of curr. cmd. and cmd. is complete, send to gis.
If at end of curr. cmd. and cmd. is not complete, insert a newline.
Else (not in any cmd.) recall line."
(interactive "*P")
(let
((n (magik-session--get-curr-cmd-num))
(p (process-mark (get-buffer-process (current-buffer)))))
(cond
(n ; in a prev. cmd.
(magik-session-copy-cmd n
(- (point)
(car (aref magik-session-prev-cmds n)))))
((>= (point) p)
(if abbrev-mode (save-excursion (expand-abbrev)))
(cond
((looking-at "[ \t\n]*\\'") ; at end of curr. cmd.
(newline arg)
(cond
((save-excursion
(and (progn
(skip-chars-backward " \t\n")
(eq (preceding-char) ?$))
(> (point) p)))
(skip-chars-backward " \t\n")
(forward-char)
(delete-region (point) (point-max))
(magik-session-send-region (marker-position p) (point)))
((magik-session--complete-magik-p p (point))
; (insert "$\n") ;; paulw - remove additional <CR> which messes with pling variables
(if magik-session-auto-insert-dollar (insert "$\n"))
(delete-region (point) (point-max))
(magik-session-send-region (marker-position p) (point)))))
((looking-at "[ \t\n]*\\$[ \t\n]*\\'")
(if (magik-session--complete-magik-p p (point))