-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathsingular.el
4273 lines (3757 loc) · 171 KB
/
singular.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
;;; singular.el --- Emacs support for Computer Algebra System Singular
;;; Commentary:
;;; Code:
;;{{{ Style and coding conventions
;; Style and coding conventions:
;;
;; - "Singular" is written with an upper-case `S' in comments, doc
;; strings, and messages. As part of symbols, it is written with
;; a lower-case `s'.
;; - When referring to the Singular interactive mode, do it in that
;; wording. Use the notation `singular-interactive-mode' only when
;; really referring to the lisp object.
;; - use a `fill-column' of 75 for doc strings and comments
;; - mark incomplete doc strings or code with `NOT READY' optionally
;; followed by an explanation what exactly is missing
;;
;; - use foldings to structure the source code but try not to exceed a
;; maximum depth of two foldings
;; - use lowercase folding titles except for first word
;; - folding-marks are `;;{{{' and `;;}}}' resp., for sake of standard
;; conformity
;; - use the foldings to modularize code. That is, each folding should be,
;; as far as possible, self-content. Define a function `singular-*-init'
;; in the folding to do the initialization of the module contained in
;; that folding. Call that function from `singular-interactive-mode',
;; for example, instead of initializing the module directly from
;; `singular-interactive-mode'. Look at the code how it is done for the
;; simple section or for the folding stuff.
;;
;; - use `singular' as prefix for all global symbols
;; - use `singular-debug' as prefix for all global symbols concerning
;; debugging.
;; - use, whenever possible without names becoming too clumsy, some unique
;; prefix inside a folding
;;
;; - mark dependencies on Emacs flavor/version with a comment of the form
;; `;; Emacs[ <version> ]' resp.
;; `;; XEmacs[ <version> ][ <nasty comment> ]'
;; specified in that order, if possible
;; - use a `cond' statement to execute Emacs flavor/version-dependent code,
;; not `if'. This is to make such checks more extensible.
;; - try to define different functions for different flavors/version and
;; use `singular-fset' at library-loading time to set the function you
;; really need. If the function is named `singular-<basename>', the
;; flavor/version-dependent functions should be named
;; `singular-<flavor>[-<version>]-<basename>'.
;;
;; - use `singular-debug' for debugging output/actions
;; - to switch between buffer and process names, use the functions
;; `singular-process-name-to-buffer-name' and
;; `singular-buffer-name-to-process-name'
;; - call the function `singular-keep-region-active' as last statement in
;; an interactive function that should keep the region active (for
;; example, in functions that move the point). This is necessary to keep
;; XEmacs' zmacs regions active.
;; - to get the process of the current buffer, use `singular-process'. To
;; get the current process mark, use `singular-process-mark'. Both
;; functions check whether Singular is alive and throw an error if not,
;; so you do not have to care about that yourself. If you do not want an
;; error specify non-nil argument NO-ERROR. But use them anyway.
;; - we assume that the buffer is *not* read-only
;; - use `=' instead of `eq' when comparing buffer locations. Even if you
;; are sure that both operands are integers.
;;}}}
;;{{{ Code common to both modes
;;{{{ Customizing
(defgroup singular nil
"Emacs interface to Singular.
By now, the Emacs interface to Singular consists of Singular interactive
mode only. Singular interactive mode provides a convenient front end to
interactive Singular sessions running inside Emacs.
In far future maybe there will be a mode for editing Singular source code
such as libraries or procedures."
:group 'external)
(defgroup singular-faces nil
"Faces in Singular mode and Singular interactive mode."
:group 'faces
:group 'singular-interactive)
;;}}}
;;{{{ Debugging stuff
(defvar singular-debug nil
"List of modes to debug or t to debug all modes.
Currently, the following modes are supported:
`interactive',
`interactive-filter'.")
(defun singular-debug-format (string)
"Return STRING in a nicer format."
(save-match-data
(while (string-match "\n" string)
(setq string (replace-match "^J" nil nil string)))
(if (> (length string) 16)
(concat "<" (substring string 0 7) ">...<" (substring string -8) ">")
(concat "<" string ">"))))
(defmacro singular-debug (mode form &optional else-form)
"Major debugging hook for singular.el.
Evaluates FORM if `singular-debug' equals t or if MODE is an element
of `singular-debug', othwerwise ELSE-FORM."
`(if (or (eq singular-debug t)
(memq ,mode singular-debug))
,form
,else-form))
;;}}}
;;{{{ Determining version
(defvar singular-emacs-flavor nil
"A symbol describing the current Emacs.
Currently, only Emacs \(`emacs') and XEmacs \(`xemacs') are supported.")
(defvar singular-emacs-major-version nil
"An integer describing the major version of the current emacs.")
(defvar singular-emacs-minor-version nil
"An integer describing the minor version of the current emacs.")
(defun singular-fset (real-function emacs-function xemacs-function)
"Set REAL-FUNCTION to one of the functions, in dependency on Emacs flavor and version.
Sets REAL-FUNCTION to XEMACS-FUNCTION if `singular-emacs-flavor' is
`xemacs', otherwise sets REAL-FUNCTION to EMACS-FUNCTION.
This is not as common as it would be desirable. But it is sufficient so
far."
(cond
;; XEmacs
((eq singular-emacs-flavor 'xemacs)
(fset real-function xemacs-function))
;; Emacs
(t
(fset real-function emacs-function))))
(defun singular-set-version ()
"Determine flavor, major version, and minor version of current emacs.
singular.el is guaranteed to run on Emacs 20.3 and XEmacs 20.3.
It should run on newer version and on slightly older ones, too.
This function is called exactly once when singular.el is loaded."
;; get major and minor versions first
(if (and (boundp 'emacs-major-version)
(boundp 'emacs-minor-version))
(setq singular-emacs-major-version emacs-major-version
singular-emacs-minor-version emacs-minor-version)
(with-output-to-temp-buffer "*singular warnings*"
(princ
"You seem to have quite an old Emacs or XEmacs version. Some of the
features from singular.el will not work properly. Consider upgrading to a
more recent version of Emacs or XEmacs. singular.el is guaranteed to run
on Emacs 20.3 and XEmacs 20.3."))
;; assume the oldest version we support
(setq singular-emacs-major-version 20
singular-emacs-minor-version 3))
;; get flavor
(if (string-match "XEmacs\\|Lucid" emacs-version)
(setq singular-emacs-flavor 'xemacs)
(setq singular-emacs-flavor 'emacs)))
(singular-set-version)
;;}}}
;;{{{ Syntax table
(defvar singular-mode-syntax-table nil
"Syntax table for `singular-interactive-mode' resp. `singular-mode'.")
(if singular-mode-syntax-table
()
(setq singular-mode-syntax-table (make-syntax-table))
;; stolen from cc-mode.el except for back-tics which are special to Singular
(modify-syntax-entry ?_ "_" singular-mode-syntax-table)
(modify-syntax-entry ?\\ "\\" singular-mode-syntax-table)
(modify-syntax-entry ?+ "." singular-mode-syntax-table)
(modify-syntax-entry ?- "." singular-mode-syntax-table)
(modify-syntax-entry ?= "." singular-mode-syntax-table)
(modify-syntax-entry ?% "." singular-mode-syntax-table)
(modify-syntax-entry ?< "." singular-mode-syntax-table)
(modify-syntax-entry ?> "." singular-mode-syntax-table)
(modify-syntax-entry ?& "." singular-mode-syntax-table)
(modify-syntax-entry ?| "." singular-mode-syntax-table)
(modify-syntax-entry ?\' "\"" singular-mode-syntax-table)
(modify-syntax-entry ?\` "\"" singular-mode-syntax-table)
;; block and line-oriented comments
(cond
;; Emacs
((eq singular-emacs-flavor 'emacs)
(modify-syntax-entry ?/ ". 124b" singular-mode-syntax-table)
(modify-syntax-entry ?* ". 23" singular-mode-syntax-table))
;; XEmacs
(t
(modify-syntax-entry ?/ ". 1456" singular-mode-syntax-table)
(modify-syntax-entry ?* ". 23" singular-mode-syntax-table)))
(modify-syntax-entry ?\n "> b" singular-mode-syntax-table)
(modify-syntax-entry ?\^m "> b" singular-mode-syntax-table))
(defun singular-mode-syntax-table-init ()
"Initialize syntax table of current buffer.
This function is called at mode initialization time."
(set-syntax-table singular-mode-syntax-table))
;;}}}
;;{{{ Miscellaneous
(defsubst singular-keep-region-active ()
"Do whatever is necessary to keep the region active in XEmacs.
Ignore byte-compiler warnings you might see. This is not needed for
Emacs."
;; XEmacs. We do not use the standard way here to test for flavor
;; because it is presumably faster with that test on `boundp'.
(and (boundp 'zmacs-region-stays)
(setq zmacs-region-stays t)))
;;}}}
;;}}}
;;{{{ Singular interactive mode
;;{{{ Customizing
;; Note:
;;
;; Some notes on Customize:
;;
;; - The documentation states that for the `:initialize' option of
;; `defcustom' the default value is `custom-initialize-set'. However, in
;; the source code of Customize `custom-initialize-reset' is used. So
;; better always specify the `:initialize' option explicitly.
;; - Customize is bad at setting buffer-local variables or properties.
;; This is quite natural since Customize itself uses its own buffer. So
;; changing buffer-local variables and properties with Customize is
;; possible only at a "Singular-global" level. That is, for all buffers
;; currently having Singular interactive mode as major mode. The function
;; `singular-map-buffer' helps to do such customization.
;; - Important note: Customizable variables are not automatically marked as
;; user options. This has to be done as usual by marking them with a '*'
;; as first character of the documentation string. Without that, the
;; variables are not accessible to, for example, `set-variable'.
;;
;; Some common customizing patterns:
;;
;; - How to customize buffer-local properties?
;; First, the `defcustom' itself must not set anything buffer-local since
;; at time of its definition (most likely) no Singular buffers will be
;; around. If there are Singular buffers we do not care about them. But
;; anyhow, at definition of the `defcustom' the global default has to be
;; set. Hence, the `:initialize' option should be set to
;; `custom-initialize-default'.
;; The buffer-local initialization has to be done at mode initialization
;; time. The global default value should then be used to set the local
;; properties.
;; At last, the function specified with the `:set' option should set the
;; local properties in all Singular buffers to the new, customized value.
;; Most likely, the function `singular-map-buffer' may be used for that.
;; In addition, the function should, of course, set the global value via
;; `set-default'.
;; For an example, see `singular-folding-line-move-ignore-folding'.
;;
;; - How to encapsulate other mode's global variables into Singular
;; interactive mode variables?
;; Set them always. That is, set them if the `defcustom' is evaluated
;; (use `custom-initialize-reset' as `:initial' function) and set them
;; when the Singular interactive mode variable is customized (by means
;; of an appropriate `:set' function).
;; For an example, see `singular-section-face-alist' (which does not
;; encapsulate another mode's variable, but Singular interactive mode's
;; own variable `singular-simple-sec-clear-type').
(defgroup singular-interactive nil
"Running interactive Singular sessions inside Emacs."
:group 'singular
:group 'processes)
(defgroup singular-sections-and-foldings nil
"Sections and foldings in Singular interactive mode."
:group 'singular-interactive)
(defgroup singular-interactive-miscellaneous nil
"Miscellaneous settings for Singular interactive mode."
:group 'singular-interactive)
(defgroup singular-demo-mode nil
"Settings concerning Singular demo mode."
:group 'singular-interactive)
(defun singular-map-buffer (func &rest args)
"Apply FUNC to ARGS in all existing Singular buffers.
That is, in all buffers having Singular interactive major mode. The
function is executed in the context of the buffer. This is a must-have for
the customizing stuff to change buffer-local properties."
(save-excursion
(mapcar (function
(lambda (buffer)
(set-buffer buffer)
(if (eq major-mode 'singular-interactive-mode)
(apply func args))))
(buffer-list))))
;;}}}
;;{{{ Comint
;; Note:
;;
;; We require Comint, but we really do not use it too much. One may argue
;; that this is bad since Comint is a standardized way to communicate with
;; external processes. One may argue further that many experienced Emacs
;; users are forced now to re-do their Comint customization for Singular
;; interactive mode. However, we believe that the intersection between
;; experienced Emacs users and users of Singular interactive mode is almost
;; empty.
;;
;; In fact, we used Comint really much in the beginning of this project.
;; Later during development it turned at that using Comint's input and
;; output processing is to inflexible and not appropriate for Singular
;; interactive mode with its input and output sections. So we begun to
;; rewrite large portions of Comint to adapt it to our needs. At some
;; point it came clear that it would be best to throw out Comint
;; alltogether, would not have been there some auxilliary functions which
;; are really useful but annoying to rewrite. These are, for example, the
;; command line history functions or the completion stuff offered by
;; Comint.
;;
;; Our policy with regard to these remainders of Comint is: Use the
;; functions to bind them to keys, but do not use them internally.
;; Encapsulate Comint customization into Singular interactive mode
;; customization. In particular, do not take care about Comint settings
;; which already may be present, overwrite them. Hide Comint from the
;; user.
;;
;; Here is how exactly we use Comint:
;;
;; - All variables necessary to use Comint's input ring are properly
;; initialized. One may find this in the `History' folding.
;; - `comint-prompt-regexp' is initialized since it is used in some
;; of the functions regarding input ring handling. Furthermore, its
;; initialization enables us to use functions as `comint-bol', etc.
;; Initialization is done in the `Skipping and stripping prompts ...'
;; folding.
;; - We call `comint-mode' as first step in `singular-interactive-mode'.
;; Most of the work done there is to initialize the local variables as
;; necessary. Besides that, the function does nothing that interferes
;; with Singular interactive mode. To be consequent we set
;; `comint-mode-hook' temporarily to nil when calling `comint-mode'.
;; - In `singular-exec', we use `comint-exec-1' to fire up the process.
;; Furthermore, we set `comint-ptyp' there as it is used in the signal
;; sending commands of Comint. All that `comint-exec-1' does is that it
;; sets up the process environment (it adds or modifies the setting of
;; the 'TERM' variable), sets the execution directory, and does some
;; magic with the process coding stuff.
;; - One more time the most important point: we do *not* use Comint's
;; output and input processing. In particular, we do not run any of
;; Comint's hooks on input or output. Anyway, we do better, don't we?
(require 'comint)
(defun singular-comint-init ()
"Initialize comint stuff for Singular interactive mode.
This function is called at mode initialization time."
(setq comint-completion-addsuffix '("/" . "")))
;;}}}
;;{{{ Font-locking
(defvar singular-font-lock-error-face 'singular-font-lock-error-face
"Face name to use for Singular errors.")
(defvar singular-font-lock-warning-face 'singular-font-lock-warning-face
"Face name to use for Singular warnings.")
(defvar singular-font-lock-prompt-face 'singular-font-lock-prompt-face
"Face name to use for Singular prompts.")
(defface singular-font-lock-error-face
'((((class color)) (:foreground "Red" :bold t))
(t (:inverse-video t :bold t)))
"*Font Lock mode face used to highlight Singular errors."
:group 'singular-faces)
(defface singular-font-lock-warning-face
'((((class color)) (:foreground "OrangeRed" :bold nil))
(t (:inverse-video t :bold t)))
"*Font Lock mode face used to highlight Singular warnings."
:group 'singular-faces)
(defface singular-font-lock-prompt-face
'((((class color) (background light)) (:foreground "Blue" :bold t))
(((class color) (background dark)) (:foreground "LightSkyBlue" :bold t))
(t (:inverse-video t :bold t)))
"*Font Lock mode face used to highlight Singular prompts."
:group 'singular-faces)
(defconst singular-font-lock-singular-types nil
"List of Singular types.")
(eval-when-compile
(setq singular-font-lock-singular-types
'("def" "bigint" "ideal" "int" "intmat" "intvec" "link" "list" "map"
"matrix" "module" "number" "poly" "proc" "qring" "resolution" "ring"
"string" "vector")))
(defconst singular-interactive-font-lock-keywords-1
'(
("^\\([>.]\\) " 1 singular-font-lock-prompt-face t)
("^ [\\?].*" 0 singular-font-lock-error-face t)
("^// \\*\\*.*" 0 singular-font-lock-warning-face t)
)
"Subdued level highlighting for Singular interactive mode")
(defconst singular-interactive-font-lock-keywords-2
(append
singular-interactive-font-lock-keywords-1
(eval-when-compile
(list
(cons
(concat "\\<" (regexp-opt singular-font-lock-singular-types t) "\\>")
'font-lock-type-face))))
"Medium level highlighting for Singular interactive mode")
(defconst singular-interactive-font-lock-keywords-3
(append
singular-interactive-font-lock-keywords-2
'(
;; note: we use font-lock-reference-face here even Emacs says that
;; this face is obsolete and suggests to use font-lock-constant-face,
;; since XEmacs20/21 does not know the constant-face but the
;; reference-face.
("^ [\\?].*`\\(\\sw\\sw+;?\\)`" 1 font-lock-reference-face t)
))
"Gaudy level highlighting for Singular interactive mode.")
(defconst singular-interactive-font-lock-keywords singular-interactive-font-lock-keywords-1
"Default highlighting for Singular interactive mode.")
(defconst singular-interactive-font-lock-defaults
'((singular-interactive-font-lock-keywords
singular-interactive-font-lock-keywords-1
singular-interactive-font-lock-keywords-2
singular-interactive-font-lock-keywords-3)
;; KEYWORDS-ONLY (do not fontify strings & comments if non-nil)
nil
;; CASE-FOLD (ignore case if non-nil)
nil
;; SYNTAX-ALIST (add this to Font Lock's syntax table)
((?_ . "w"))
;; SYNTAX-BEGIN
singular-section-goto-beginning)
"Default expressions to highlight in Singular interactive mode.")
(defun singular-interactive-font-lock-init ()
"Initialize Font Lock mode for Singular interactive mode.
For XEmacs, this function is called exactly once when singular.el is
loaded.
For Emacs, this function is called at mode initialization time."
(cond
;; Emacs
((eq singular-emacs-flavor 'emacs)
(singular-debug 'interactive (message "Setting up Font Lock mode for Emacs"))
(set (make-local-variable 'font-lock-defaults)
singular-interactive-font-lock-defaults))
;; XEmacs
((eq singular-emacs-flavor 'xemacs)
(singular-debug 'interactive (message "Setting up Font Lock mode for XEmacs"))
(put 'singular-interactive-mode
'font-lock-defaults singular-interactive-font-lock-defaults))))
;; XEmacs Font Lock mode initialization
(cond
;; XEmacs
((eq singular-emacs-flavor 'xemacs)
(singular-interactive-font-lock-init)))
;;}}}
;;{{{ Key map
(defvar singular-interactive-mode-map nil
"Key map to use in Singular interactive mode.")
(if singular-interactive-mode-map
()
;; create empty keymap first
(cond
;; Emacs
((eq singular-emacs-flavor 'emacs)
(setq singular-interactive-mode-map (make-sparse-keymap)))
;; XEmacs
(t
(setq singular-interactive-mode-map (make-keymap))
(set-keymap-name singular-interactive-mode-map
'singular-interactive-mode-map)))
;; global settings
(define-key help-map [?\C-s] 'singular-help)
;; settings for `singular-interactive-map'
(substitute-key-definition 'beginning-of-line 'singular-beginning-of-line
singular-interactive-mode-map global-map)
(define-key singular-interactive-mode-map "\t" 'singular-dynamic-complete)
(define-key singular-interactive-mode-map [?\C-m] 'singular-send-or-copy-input)
(define-key singular-interactive-mode-map [?\C-l] 'singular-recenter)
;; Comint functions
(define-key singular-interactive-mode-map [?\M-r] 'comint-previous-matching-input)
(define-key singular-interactive-mode-map [?\M-s] 'comint-next-matching-input)
;; C-c prefix
(define-key singular-interactive-mode-map [?\C-c ?\C-e] 'singular-example)
(define-key singular-interactive-mode-map [?\C-c ?\C-t] 'singular-toggle-truncate-lines)
(define-key singular-interactive-mode-map [?\C-c ?\C-f] 'singular-folding-toggle-fold-at-point-or-all)
(define-key singular-interactive-mode-map [?\C-c ?\C-o] 'singular-folding-toggle-fold-latest-output)
(define-key singular-interactive-mode-map [?\C-c ?\C-w] 'singular-section-kill)
(define-key singular-interactive-mode-map [?\C-c ?\C-d] 'singular-demo-load)
(define-key singular-interactive-mode-map [?\C-c ?\C-l] 'singular-load-library)
(define-key singular-interactive-mode-map [(control c) (<)] 'singular-load-file)
(define-key singular-interactive-mode-map [?\C-c ?\C-r] 'singular-restart)
(define-key singular-interactive-mode-map [?\C-c ?\$] 'singular-exit-singular)
(define-key singular-interactive-mode-map [?\C-c ?\C-c] 'singular-control-c))
(defun singular-cursor-key-model-set (key-model)
"Set keys according to KEY-MODEL.
KEY-MODEL should be one of the valid values of `singular-cursor-key-model'."
;; convert symbols to list
(cond ((eq key-model 'emacs)
(setq key-model '(cursor cursor history)))
((eq key-model 'terminal)
(setq key-model '(history history cursor))))
;; work through list
(mapcar (function (lambda (spec)
(let ((key-description (nth 0 spec))
(prev-key (nth 1 spec))
(next-key (nth 2 spec)))
(cond ((eq key-description 'cursor)
(define-key singular-interactive-mode-map prev-key 'previous-line)
(define-key singular-interactive-mode-map next-key 'next-line))
((eq key-description 'history)
(define-key singular-interactive-mode-map prev-key 'comint-previous-input)
(define-key singular-interactive-mode-map next-key 'comint-next-input))
(t
(define-key singular-interactive-mode-map prev-key nil)
(define-key singular-interactive-mode-map next-key nil))))))
;; here is where list position are mapped to keys
(list (list (nth 0 key-model) [up] [down])
(list (nth 1 key-model) [?\C-p] [?\C-n])
(list (nth 2 key-model) [?\M-p] [?\M-n]))))
(defcustom singular-cursor-key-model 'emacs
"*Keys to use for cursor movement and history access, respectively.
An experienced Emacs user would prefer setting `singular-cursor-key-model'
to `emacs'. This means that C-p, C-n, and the cursor keys move the cursor,
whereas M-p and M-n scroll through the history of Singular commands.
On the other hand, an user used to running Singular in a, say, xterm, would
prefer setting `singular-cursor-key-model' to `terminal'. This means that
C-p, C-n, and the cursor keys scroll through the history of Singular
commands, whereas M-p and M-n move the cursor.
For those who do not like neither standard setting, there is the
possibility to set this variable to a list of three elements where
- the first element specifies the key bindings for the cursor keys,
- the second element specifies the key bindings for C-p and C-n, and
- the third element specifies the key bindings for M-p and M-n.
Each list element should be one of
- `cursor', meaning that the corresponding keys are bound to cursor movement,
- `history', meaning that the corresponding keys are bound to history access,
or
- nil, meaning that the corresponding keys are not bound at all.
Changing this variable has an immediate effect only if one uses
\\[customize] to do so."
:type '(choice (const :tag "Emacs-like" emacs)
(const :tag "Terminal-like" terminal)
(list :tag "User-defined"
(choice :format "Cursor keys: %[Value Menu%] %v"
:value cursor
(const :tag "Cursor movement" cursor)
(const :tag "History access" history)
(const :tag "No binding" nil))
(choice :format "C-p, C-n: %[Value Menu%] %v"
:value cursor
(const :tag "Cursor movement" cursor)
(const :tag "History access" history)
(const :tag "No binding" nil))
(choice :format "M-p, M-n: %[Value Menu%] %v"
:value history
(const :tag "Cursor movement" cursor)
(const :tag "History access" history)
(const :tag "No binding" nil))))
:initialize 'custom-initialize-reset
:set (function
(lambda (var value)
(singular-cursor-key-model-set value)
(set-default var value)))
:group 'singular-interactive-miscellaneous)
(defun singular-interactive-mode-map-init ()
"Initialize key map for Singular interactive mode.
This function is called at mode initialization time."
(use-local-map singular-interactive-mode-map))
;;}}}
;;{{{ Menus and logos
(defvar singular-interactive-mode-menu-1 nil
"NOT READY [docu]")
(defvar singular-interactive-mode-menu-2 nil
"NOT READY [docu]")
(defconst singular-menu-initial-library-menu
'(["other..." (singular-load-library t) t])
"Menu definition for the inital library sub menu.
This should be a list of vectors.")
(defun singular-menu-build-libraries-menu (definition)
"Given a description of the libraries and their categories, builds up a
menu definition including submenus which can be given to
`easy-menu-change'. By side effect sets the variable
`singular-standard-libraries-alist' to the alist of all library names.
This alist can be used for completion."
(let ((menudef ())
(libs definition)
elem)
(while libs
(setq elem (car libs))
(if (> (length elem) 1)
(setq menudef
(append
(list
(append (list (car elem))
(singular-menu-build-libraries-menu (cdr elem))))
menudef))
(setq menudef
(append (list (vector (car elem)
(list 'singular-load-library nil
(car elem))
t))
menudef))
(setq singular-standard-libraries-alist
(append (list elem) singular-standard-libraries-alist)))
(setq libs (cdr libs)))
menudef))
(defun singular-menu-install-libraries ()
"Update the singular command menu with libraries.
Scans the variable `singular-standard-libraries-with-categories' and builds
up a menu with submenues for each category in the submenu (\"Commands\"
\"Libraries\")."
(singular-debug 'interactive (message "Installing library menu"))
;; To be compatible with older versions of singular.el (resp. of lib-cmpl.el)
;; we check whether the variable
;; `singular-standard-libraries-with-categories' is set. If not, we use the
;; value of `singular-standard-libraries-alist' instead.
(if (not singular-standard-libraries-with-categories)
(setq singular-standard-libraries-with-categories
singular-standard-libraries-alist))
(easy-menu-change '("Commands")
"Libraries"
(append
(singular-menu-build-libraries-menu
singular-standard-libraries-with-categories)
(append '("---") singular-menu-initial-library-menu))))
(defun singular-menu-init ()
"Initialize menu stuff for Singular interactive mode.
This function is called by `singular-exec'."
(singular-debug 'interactive (message "Initializing menue stuff"))
(make-local-variable 'singular-standard-libraries-alist)
(make-local-variable 'singular-standard-libraries-with-categories))
(defun singular-menu-deinstall-libraries ()
"Initialize library submenu from singular command menu.
Sets the submenu (\"Commands\" \"Libraries\") to the value of
`singular-menu-initial-library-menu'."
(singular-debug 'interactive
(message "Removing libraries from menu"))
(easy-menu-change '("Commands") "Libraries" singular-menu-initial-library-menu))
;; For some reasons emacs inserts new menus in the oppsite order.
;; Defining menu-2 prior to menu-1 will result in the follwoing menu:
;; Singular Commands
;; That's what we want. So DO NOT exchange both (or ..) statements!
(or singular-interactive-mode-menu-2
(easy-menu-define
singular-interactive-mode-menu-2
singular-interactive-mode-map ""
(list
"Commands"
["Fold/Unfold Latest Output" singular-folding-toggle-fold-latest-output t]
["Fold/Unfold At Point" singular-folding-toggle-fold-at-point-or-all t]
["Fold All Output" singular-folding-fold-all-output t]
["Unfold All Output" singular-folding-unfold-all-output t]
"---"
["Truncate Lines" singular-toggle-truncate-lines
:style toggle :selected truncate-lines]
"--"
(append
'("Libraries")
singular-menu-initial-library-menu)
["Load File..." singular-load-file t]
"---"
["Load Demo..." singular-demo-load (or singular-demo-exit-on-load
(not singular-demo-mode))]
["Exit Demo" singular-demo-exit singular-demo-mode]
)))
(or singular-interactive-mode-menu-1
(easy-menu-define singular-interactive-mode-menu-1
singular-interactive-mode-map ""
'("Singular"
["Start Default" singular t]
["Start..." singular-other t]
["Restart" singular-restart t]
"---"
["Interrupt" singular-control-c t]
["Exit" singular-exit-singular t]
"---"
["Preferences" (customize-group 'singular-interactive) t]
["Singular Example" singular-example t]
["Singular Help" singular-help t])))
(defun customize-singular-interactive ()
(interactive)
(customize-group 'singular-interactive))
(defun singular-interactive-mode-menu-init ()
"Initialize menus for Singular interactive mode.
This function is called at mode initialization time."
;; Remove any potential menu which comint-mode might has added.
(cond
;; Emacs
((eq singular-emacs-flavor 'emacs)
;; Note that easy-menu-remove is a nop in emacs.
(define-key comint-mode-map [menu-bar signals] nil)
(define-key comint-mode-map [menu-bar inout] nil)
(define-key comint-mode-map [menu-bar completion] nil))
;;Xemacs
(t
(easy-menu-remove '("Singular"))
(easy-menu-remove '("Comint1")) ; XEmacs 20
(easy-menu-remove '("Comint2")) ; XEmacs 20
(easy-menu-remove '("History")) ; XEmacs 20
(easy-menu-remove '("Complete")) ; XEmacs 21
(easy-menu-remove '("In/Out")) ; XEmacs 21
(easy-menu-remove '("Signals")))) ; XEmacs 21
;; Note: easy-menu-add is not necessary in emacs, since the menu
;; is added automatically with the keymap.
;; See help on `easy-menu-add'
(easy-menu-add singular-interactive-mode-menu-1)
(easy-menu-add singular-interactive-mode-menu-2))
;;}}}
;;{{{ Skipping and stripping prompts and whitespace and other things
;; Note:
;;
;; Most of these functions handle prompt recognition, prompt skipping,
;; prompt stripping, and so on. It turned out that it would be very
;; inefficient to use one generic regular expression to do so. Hence, we
;; decided to hardcode the prompt skipping and stripping in an API. If one
;; decides to use some other prompt the whole API has to be changed.
;; Hopefully, the Singular prompt does not change in near future ...
;;
;; In addition to the API, the Comint mode variable `comint-mode-regexp' is
;; set on initialization of Singular interactive mode. Singular
;; interactive mode seems to do quite well without that, but for safety the
;; variable is set nonetheless.
(defsubst singular-prompt-skip-forward ()
"Skip forward over prompts."
(if (looking-at "\\([>.] \\)+")
(goto-char (match-end 0))))
(defsubst singular-prompt-skip-backward ()
"Skip backward over prompts."
;; is that really the simplest and fastest method? The problem is that
;; `re-search-backward' is not greedy so on an regexp as "\\([>.] \\)+"
;; it stops right after the first occurence of the sub-expression.
;; Anyway, the `(- (point) 2)' expression is OK, even at bob.
(while (re-search-backward "[>.] " (- (point) 2) t)))
(defun singular-prompt-remove-string (string)
"Remove all prompts from STRING."
(while (string-match "^\\([>.] \\)+" string)
(setq string (replace-match "" t t string)))
string)
(defun singular-prompt-remove-region (beg end)
"Remove all superfluous prompts from region between BEG and END.
Removes only sequences of prompts that start at beginning of line. Removes
all but the last prompt of a sequence if that sequence ends at END,
otherwise removes all prompts.
The region between BEG and END should be accessible. BEG should be less
than or equal to END.
Leaves point at the position of the last sequence of prompts which has been
deleted or at BEG if nothing has been deleted."
;; we cannot exclude this case, I think
(if (/= beg end)
;; that's a nice trick to keep the last prompt if it ends at END: we
;; set `(1- END)' as search limit. Since BEG /= END there can be no
;; problems with the `1-'.
(let ((end (copy-marker (1- end))))
(goto-char beg)
(while (re-search-forward "^\\([>.] \\)+" end t)
(delete-region (match-beginning 0) (match-end 0)))
(set-marker end nil))))
(defun singular-prompt-remove-filter (beg end simple-sec-start)
"Remove all superfluous prompts from text inserted into buffer."
(cond (;; if a new simple section has been created remove all
;; prompts from that simple section
simple-sec-start
(singular-prompt-remove-region simple-sec-start end))
(;; if no simple section has been created check whether maybe the
;; region between beg and end consists of prompts only. This in
;; case that the user issued a command that did not output any
;; text.
(and (goto-char beg)
(re-search-forward "\\([>.] \\)+" end t)
(= (match-end 0) end))
(singular-prompt-remove-region (progn (beginning-of-line) (point))
end))))
(defun singular-white-space-strip (string &optional trailing leading)
"Strip off trailing or leading whitespace from STRING.
Strips off trailing whitespace if optional argument TRAILING is non-nil.
Strips off leading whitespace if optional argument LEADING is non-nil."
(let (beg end)
(and leading
(string-match "\\`[ \t\n\r\f]+" string)
(setq beg (match-end 0)))
(and trailing
(string-match "[ \t\n\r\f]+\\'" string)
(setq end (match-beginning 0)))
(if (or beg end)
(substring string (or beg 0) (or end (length string)))
string)))
(defconst singular-comint-prompt-regexp "^\\([>.] \\)+"
"Regexp to match prompt patterns in Singular.
This variable is used to initialize `comint-prompt-regexp' when Singular
interactive mode starts up. It is not used in Singular interactive mode
itself! One should refer to the source code for more information on how to
adapt Singular interactive mode to some other prompt.")
(defun singular-prompt-init ()
"Initialize prompt skipping and stripping for Singular interactive mode.
This function is called at mode initialization time."
;; remove superfluous prompts in singular output
(add-hook 'singular-post-output-filter-functions 'singular-prompt-remove-filter nil t)
;; some relict from Comint mode
(setq comint-prompt-regexp singular-comint-prompt-regexp))
;; required to use prompt-regexp
(setq comint-use-prompt-regexp t)
;;}}}
;;{{{ Miscellaneous
;; Note:
;;
;; We assume a one-to-one correspondence between Singular buffers and
;; Singular processes. We always have (equal buffer-name (concat "*"
;; process-name "*")).
(defsubst singular-buffer-name-to-process-name (buffer-name)
"Create the process name for BUFFER-NAME.
The process name is the buffer name with surrounding `*' stripped off."
(substring buffer-name 1 -1))
(defsubst singular-process-name-to-buffer-name (process-name)
"Create the buffer name for PROCESS-NAME.
The buffer name is the process name with surrounding `*'."
(concat "*" process-name "*"))
(defsubst singular-run-hook-with-arg-and-value (hook value)
"Call functions on HOOK.
Provides argument VALUE to the functions. If a function returns a non-nil
value it replaces VALUE as new argument to the remaining functions.
Returns final VALUE."
(while hook
(setq value (or (funcall (car hook) value) value)
hook (cdr hook)))
value)
(defsubst singular-process (&optional no-error)
"Return process of current buffer.
If no process is active this function silently returns nil if optional
argument NO-ERROR is non-nil, otherwise it throws an error."
(cond ((get-buffer-process (current-buffer)))
(no-error nil)
(t (error "No Singular running in this buffer"))))
(defsubst singular-process-mark (&optional no-error)
"Return process mark of current buffer.
If no process is active this function silently returns nil if optional
argument NO-ERROR is non-nil, otherwise it throws an error."
(let ((process (singular-process no-error)))
(and process
(process-mark process))))
(defun singular-time-stamp-difference (new-time-stamp old-time-stamp)
"Return the number of seconds between NEW-TIME-STAMP and OLD-TIME-STAMP.
Both NEW-TIME-STAMP and OLD-TIME-STAMP should be in the format
that is returned, for example, by `current-time'.
Does not return a difference larger than 2^17 seconds."
(let ((high-difference (min 1 (- (car new-time-stamp) (car old-time-stamp))))
(low-difference (- (cadr new-time-stamp) (cadr old-time-stamp))))
(+ (* high-difference 131072) low-difference)))
(defun singular-error (&rest message-args)
"Apply `message' on MESSAGE-ARGS and do a `ding'.
This function should be used instead of `error' in hooks where calling
`error' is not a good idea."
(apply 'message message-args)
(ding))
(defun singular-pop-to-buffer (same-window &rest pop-to-buffer-args)
"Pop to buffer in same or other window.
Pops to buffer in same window if SAME-WINDOW equals t. Pops to buffer in
other window if SAME-WINDOW equals nil. If SAME-WINDOW equals neither t
nor nil the default behaviour of `pop-to-buffer' is used. The rest of the
arguments is passed unchanged to `pop-to-buffer'."
(let ((same-window-buffer-names
(cond
((null same-window)
nil)
((eq same-window t)
(let* ((buffer-or-name (car pop-to-buffer-args))
(buffer-name (if (bufferp buffer-or-name)
(buffer-name buffer-or-name)
buffer-or-name)))
(list buffer-name)))
(t
same-window-buffer-names))))
(apply 'pop-to-buffer pop-to-buffer-args)))
;;}}}
;;{{{ Miscellaneous interactive
(defun singular-recenter (&optional arg)
"Center point in window and redisplay frame. With ARG, put point on line ARG.
The desired position of point is always relative to the current window.
Just C-u as prefix means put point in the center of the window.
If ARG is omitted or nil, erases the entire frame and then redraws with
point in the center of the current window.
Scrolls window to the left margin and moves point to beginning of line."
(interactive "P")
(singular-reposition-point-and-window)
(recenter arg))
(defun singular-reposition-point-and-window ()
"Scroll window to the left margin and move point to beginning of line."
(interactive)
(set-window-hscroll (selected-window) 0)
(move-to-column 0)
;; be careful where to place point
(singular-prompt-skip-forward))
(defun singular-toggle-truncate-lines ()
"Toggle `truncate-lines'.
A non-nil value of `truncate-lines' means do not display continuation
lines\; give each line of text one screen line.
Repositions window and point after toggling `truncate-lines'."
(interactive)
(setq truncate-lines (not truncate-lines))
;; reposition so that user does not get confused
(singular-reposition-point-and-window)
;; avoid calling `recenter' since it changes window layout more than
;; necessary
(redraw-frame (selected-frame)))
;; this is not a buffer-local variable even if at first glance it seems
;; that it should be one. But if one changes buffer the contents of this
;; variable becomes irrelevant since the last command is no longer a
;; horizontal scroll command. The same is true for the initial value, so
;; we set it to nil.
(defvar singular-scroll-previous-amount nil
"Amount of previous horizontal scroll command.")
(defun singular-scroll-right (&optional scroll-amount)
"Scroll selected window SCROLL-AMOUNT columns right.
SCROLL-AMOUNT defaults to amount of previous horizontal scroll command. If
the command immediately preceding this command has not been a horizontal
scroll command SCROLL-AMOUNT defaults to window width minus 2.
Moves point to leftmost visible column."
(interactive "P")