-
Notifications
You must be signed in to change notification settings - Fork 2
/
sweeprolog.el
7609 lines (6800 loc) · 302 KB
/
sweeprolog.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
;;; sweeprolog.el --- Embedded SWI-Prolog -*- lexical-binding:t -*-
;; Copyright (C) 2022-2024 Eshel Yaron
;; Author: Eshel Yaron <me@eshelyaron.com>
;; Maintainer: Eshel Yaron <~eshel/dev@lists.sr.ht>
;; Keywords: prolog languages extensions
;; URL: https://git.sr.ht/~eshel/sweep
;; Package-Version: 0.27.5
;; Package-Requires: ((emacs "27.1") (compat "29.1.4.2"))
;; This file is NOT part of GNU Emacs.
;;; Commentary:
;; Sweep is an embedding of SWI-Prolog in Emacs. It uses the C
;; interfaces of both SWI-Prolog and Emacs Lisp to let you query
;; Prolog directly from Elisp. On top of this tight integration,
;; Sweep provides an advanced development environment for SWI-Prolog
;; in Emacs.
;;
;; For more information, see the Sweep manual at
;; <https://eshelyaron.com/sweep.html>. To read the manual inside
;; Emacs, do M-x sweeprolog-info-manual, or evaluate (info "(sweep)Top").
;;; Code:
(require 'compat)
(require 'comint)
(require 'xref)
(require 'autoinsert)
(require 'eldoc)
(require 'flymake)
(require 'help-mode)
(require 'find-func)
(require 'shr)
(require 'info-look)
;;;; Global variables
(defvar sweeprolog--directory (file-name-directory load-file-name))
(defvar sweeprolog--initialized nil)
(defvar sweeprolog-prolog-server-port nil)
(defvar sweeprolog-read-predicate-history nil)
(defvar sweeprolog-read-module-history nil)
(defvar sweeprolog-read-functor-history nil)
(defvar sweeprolog-top-level-signal-goal-history nil)
(defvar sweeprolog--extra-init-args nil)
(defvar sweeprolog-insert-term-functions
'(sweeprolog-maybe-extract-region-to-predicate
sweeprolog-maybe-insert-next-clause
sweeprolog-maybe-define-predicate)
"List of functions that insert a Prolog term in a certain context.
See `sweeprolog-insert-term-dwim' for more details.")
(defvar sweeprolog-mode-syntax-table
(let ((table (make-syntax-table)))
(modify-syntax-entry ?# "." table)
(modify-syntax-entry ?$ "." table)
(modify-syntax-entry ?& "." table)
(modify-syntax-entry ?+ "." table)
(modify-syntax-entry ?- "." table)
(modify-syntax-entry ?. "." table)
(modify-syntax-entry ?: "." table)
(modify-syntax-entry ?< "." table)
(modify-syntax-entry ?= "." table)
(modify-syntax-entry ?> "." table)
(modify-syntax-entry ?? "." table)
(modify-syntax-entry ?@ "." table)
(modify-syntax-entry ?^ "." table)
(modify-syntax-entry ?~ "." table)
(modify-syntax-entry ?_ "_" table)
(modify-syntax-entry ?| "." table)
(modify-syntax-entry ?\\ "\\" table)
(modify-syntax-entry ?\' "\"" table)
(modify-syntax-entry ?` "\"" table)
(modify-syntax-entry ?% "<" table)
(modify-syntax-entry ?\n ">" table)
(modify-syntax-entry ?* ". 23b" table)
(modify-syntax-entry ?/ ". 14" table)
(modify-syntax-entry ?! "w" table)
table))
(defvar sweeprolog-top-level-mode-syntax-table sweeprolog-mode-syntax-table)
(defvar sweeprolog-module-documentation-regexp (rx bol (zero-or-more whitespace)
":-" (zero-or-more whitespace)
"module("))
;;;; User options
(defgroup sweeprolog nil
"SWI-Prolog Embedded in Emacs."
:group 'prolog)
(defcustom sweeprolog-swipl-sources t
"Location of the SWI-Prolog source code root directory.
When non-nil, the function `sweeprolog-predicate-location'
attempts to find the C definitions of SWI-Prolog native built-in
predicates.
The value of this option can be a string, in which case it should
be the name of the SWI-Prolog source code root directory. Any
other non-nil value says to try and find the SWI-Prolog sources
among the directories that `project-known-project-roots' returns."
:package-version '((sweeprolog . "0.7.1"))
:type '(choice (const :tag "Detect" t)
(directory :tag "Manual")
(const :tag "Disable" nil)))
(defcustom sweeprolog-module-header-comment-skeleton ?\n
"Additional content for the topmost comment in module headers.
The SWI-Prolog module header inserted by \\[auto-insert] includes
a multiline comment at the very start of the buffer which
contains the name and mail address of the author based on the
user options `user-full-name' and `user-mail-address'
respectively, followed by the value of this variable, which is
interpreted as a skeleton (see `skeleton-insert'). In its
simplest form, this may be a string or a character.
This user option may be useful, for example, to include copyright
notices with the module header."
:package-version '((sweeprolog . "0.4.6"))
:type 'sexp)
(defcustom sweeprolog-indent-offset 4
"Number of columns to indent with in `sweeprolog-mode' buffers."
:package-version '((sweeprolog . "0.3.1"))
:type 'natnum)
(defcustom sweeprolog-qq-mode-alist '(("graphql" . graphql-mode)
("javascript" . js-mode)
("html" . html-mode))
"Association between Prolog quasi-quotation types and Emacs modes.
This is a list of pairs of the form (TYPE . MODE), where TYPE is
a Prolog quasi-quotation type given as a string, and MODE is a
symbol specifing a major mode."
:package-version '((sweeprolog . "0.4.3"))
:type '(alist :key-type string :value-type function))
(defcustom sweeprolog-enable-cycle-spacing t
"If non-nil and `cycle-spacing-actions' is defined, extend it.
This makes the first invocation of \\[cycle-spacing] in
`sweeprolog-mode' buffers update whitespace around point using
`sweeprolog-align-spaces', which see."
:package-version '((sweeprolog . "0.5.3"))
:type 'boolean)
(defcustom sweeprolog-analyze-buffer-on-idle t
"If non-nil, analyze `sweeprolog-mode' buffers on idle."
:package-version '((sweeprolog . "0.8.2"))
:type 'boolean)
(defcustom sweeprolog-analyze-buffer-max-size 100000
"Maximum buffer size to analyze on idle."
:package-version '((sweeprolog . "0.8.2"))
:type 'natnum)
(defcustom sweeprolog-analyze-buffer-min-interval 1.5
"Minimum idle time to wait before analyzing the buffer."
:package-version '((sweeprolog . "0.8.2"))
:type 'float)
(defcustom sweeprolog-swipl-path nil
"File name of the swipl executable.
When non-nil, this is used by the embedded SWI-Prolog runtime to
locate its \"home\" directory. Otherwise, Sweep uses
`executable-find' to find the swipl executable."
:package-version '((sweeprolog . "0.1.1"))
:type '(choice (file :tag "File name" :must-match t)
(const :tag "Search `executable-path'" nil)))
(defcustom sweeprolog-messages-buffer-name "*Sweep Messages*"
"The name of the buffer to use for logging Prolog messages."
:package-version '((sweeprolog . "0.23.1"))
:type 'string)
(defcustom sweeprolog-read-flag-prompt "Flag: "
"Prompt used for reading a Prolog flag name from the minibuffer."
:package-version '((sweeprolog . "0.1.2"))
:type 'string)
(defcustom sweeprolog-read-module-prompt "Module: "
"Prompt used for reading a Prolog module name from the minibuffer."
:package-version '((sweeprolog . "0.1.0"))
:type 'string)
(defcustom sweeprolog-read-predicate-prompt "Predicate"
"Prompt used for reading a Prolog predicate name from the minibuffer."
:package-version '((sweeprolog . "0.19.1"))
:type 'string)
(defcustom sweeprolog-read-exportable-predicate-prompt "Export predicate: "
"Prompt used for reading an exportable predicate name."
:package-version '((sweeprolog . "0.6.2"))
:type 'string)
(defcustom sweeprolog-read-pack-prompt "Pack: "
"Prompt used for reading a Prolog pack name from the minibuffer."
:package-version '((sweeprolog . "0.1.0"))
:type 'string)
(defcustom sweeprolog-top-level-display-action nil
"Display action used for displaying the `sweeprolog-top-level' buffer."
:package-version '((sweeprolog . "0.1.0"))
:type '(choice (const :tag "Default" nil)
(cons :tag "Buffer display action"
(choice (function :tag "Display Function")
(repeat :tag "Display Functions" function))
(alist :tag "Action alist"))))
(defcustom sweeprolog-top-level-min-history-length 3
"Minimum input length to record in the `sweeprolog-top-level' history.
Inputs shorther than the value of this variable will not be
inserted to the input history in `sweeprolog-top-level-mode' buffers."
:package-version '((sweeprolog . "0.2.1"))
:type 'natnum)
(defcustom sweeprolog-init-args
(append
(when (and (featurep 'xwidget-internal)
(when-let (swipl (or sweeprolog-swipl-path
(executable-find "swipl")))
(<= 90114 ; first SWI-Prolog version to
; hide XPCE private symbols
(string-to-number
(with-output-to-string
(with-current-buffer standard-output
(call-process swipl
nil '(t nil) nil
"-g"
"current_prolog_flag(version, V), writeln(V)"
"-t" "halt")))))))
;; Disable XPCE if Emacs has been built with Xwidgets to
;; workaround a potential crash due to symbol collision
;; (see https://github.com/SWI-Prolog/swipl-devel/issues/1188).
'("--pce=false"))
(list "-q"
"--no-signals"
"-g"
"create_prolog_flag(sweep,true,[access(read_only),type(boolean)])"
;; SWI-Prolog does its own locale initialization, but Emacs's
;; Elisp reader only works with certain values of LC_NUMERIC,
;; so we need to reset it after loading Prolog. This is
;; basically emulating fixup_locale from src/emacs.c:
"-g" "setlocale(numeric, _, 'C')"
"-O"
"-l"
(expand-file-name
"sweep.pl"
sweeprolog--directory)))
"List of strings used as initialization arguments for Prolog."
:package-version '((sweeprolog "0.22.2"))
:type '(repeat string))
(defcustom sweeprolog-enable-flymake t
"Whether to enable Flymake support in Sweep Prolog mode buffers."
:package-version '((sweeprolog "0.6.0"))
:type 'boolean)
(defcustom sweeprolog-note-implicit-autoloads t
"Whether Flymake should note implicitly autoload predicates."
:package-version '((sweeprolog "0.9.2"))
:type 'boolean)
(defcustom sweeprolog-enable-eldoc t
"Whether to enable ElDoc support in Sweep Prolog mode buffers."
:package-version '((sweeprolog "0.4.7"))
:type 'boolean)
(defcustom sweeprolog-enable-cursor-sensor t
"Whether to enable `cursor-sensor-mode' in Sweep Prolog mode buffers.
When non-nil, Sweep Prolog mode leverages `cursor-sensor-mode' to
highlight all occurrences of the variable at point in the current
clause."
:package-version '((sweeprolog "0.4.2"))
:type 'boolean)
(defcustom sweeprolog-new-predicate-location-function
#'sweeprolog-default-new-predicate-location
"Function used to choose a location for a new predicate definition.
It should take three arguments describing the new predicate,
FUNCTOR, ARITY and NECK, and move point to a suitable position in
the current buffer where the new predicate definition should be
inserted.
FUNCTOR is the predicate name given as a string, ARITY is its
arity given as an integer, and NECK is the neck operator of the
predicate (e.g. \":-\" for regular clauses and \"-->\" for DCG
non-terminals)."
:package-version '((sweeprolog "0.8.11"))
:type '(choice (const :tag "Below Current Predicate"
sweeprolog-default-new-predicate-location)
(const :tag "Above Current Predicate"
sweeprolog-new-predicate-location-above-current)
(function :tag "Custom Function")))
(defcustom sweeprolog-top-level-signal-default-goal "sweep_interrupt"
"Prolog goal used by default for signaling top-level threads."
:package-version '((sweeprolog "0.8.12"))
:type 'string)
(defcustom sweeprolog-highlight-holes t
"Whether to highlight holes in a dedicated face."
:package-version '((sweeprolog "0.8.12"))
:type 'boolean)
(defcustom sweeprolog-read-predicate-documentation-function
#'sweeprolog-read-predicate-documentation-default-function
"Function used for filling in information for predicate documentation.
The function should take four arguments, MODULE, FUNCTOR, ARITY
and NECK, which have the same meaning as in
`sweeprolog-definition-at-point'.
It should return a list with four elements (MOD HEAD DET SUM),
where HEAD is a string that contains a template head term for
calling the documented predicate (e.g. \"foo(+Bar, -Baz)\"), MOD
is the module name to qualify HEAD with, or nil if the documented
predicate is local to the current module and shouldn't be
module-qualified, DET is the determinism specification of the
predicate, and SUM is the first line of the predicate's
documentation, acting as a short summary."
:package-version '((sweeprolog "0.10.1"))
:type '(choice
(const
:tag "Prompt in Minibuffer"
sweeprolog-read-predicate-documentation-default-function)
(const
:tag "Use Holes"
sweeprolog-read-predicate-documentation-with-holes)
(function
:tag "Custom Function")))
(defcustom sweeprolog-enable-help-echo t
"Whether to annotate Prolog tokens with the `help-echo' property.
When non-nil, Sweep Prolog mode adds a short description to each
token via its `help-echo' text property."
:package-version '((sweeprolog "0.12.0"))
:type 'boolean)
(defcustom sweeprolog-rename-variable-allow-existing 'confirm
"Whether to allow renaming variables to existing variable names.
If it is the symbol `confirm', allow but ask for confirmation
first."
:package-version '((sweeprolog "0.15.1"))
:type '(choice (const :tag "Allow" t)
(const :tag "Confirm" confirm)
(const :tag "Refuse" nil)))
(defcustom sweeprolog-dependency-directive 'infer
"Prolog directive to use for adding dependencies.
This determines whether `sweeprolog-update-dependencies' uses
`autoload/2' or `use_module/2' directives to make implicit
dependencies into explicit dependencies.
If set to the symbol `use-module', then
`sweeprolog-update-dependencies' only uses `use_module/2'
directives. If set to the symbol `infer', then
`sweeprolog-update-dependencies' uses `autoload/2' directives
unless the buffer already contains dependency directives and all
of them are `use_module/2' directives. Any other values means to
use `autoload/2' for all added directives."
:package-version '((sweeprolog "0.17.0"))
:type '(choice (const :tag "Prefer use_module/2" use-module)
(const :tag "Prefer autoload/2" autoload)
(const :tag "Infer" infer)))
(defcustom sweeprolog-highlight-breakpoints t
"Whether to highlight breakpoints with a dedicated face."
:package-version '((sweeprolog "0.17.0"))
:type 'boolean)
(defcustom sweeprolog-predicate-visible-p-function #'sweeprolog-predicate-non-hidden-p
"Controls how `sweeprolog-read-predicate' filters completion candidates.
This affects commands that read a Prolog predicate indicator in
the minibuffer, such as \\[sweeprolog-find-predicate]
and \\[sweeprolog-describe-predicate].
If non-nil, this is a function that takes a single string
argument, and returns non-nil if that string should be included
as a completion candidate (i.e. it is not hidden). If this
user option is nil, all known predicates are provided as
completion candidates."
:package-version '((sweeprolog "0.19.1"))
:type '(choice (const :tag "Include all predicates" nil)
(const :tag "Exclude internal hidden predicates"
sweeprolog-predicate-non-hidden-p)
(function :tag "Custom exclusion predicate")))
(defcustom sweeprolog-top-level-persistent-history nil
"Controls if and where top-level buffers store persistent history.
If this option is nil, top-level buffers neither read persistent
history on start-up nor write it on exit. Otherwise, this option
specifies a file name where top-level buffers store their input
history.
If this is a string FILE, top-level buffers use the file FILE for
persistent history. FILE can be either an absolute file name or
a relative file name, in which case it is expanded relative to
the `default-directory' of the top-level buffer. If this is a
function, it is called with no arguments to produce a string with
the same meaning.
This option can also be a list of the form (project REL DEF), in
which case the persistent history file that a top-level buffer
uses depends on the project that the buffer belongs to, as
determined by `project-current'. If the buffer belongs to a
project, its persistent history file is REL relative to the
project's root directory. Otherwise, the persistent history file
is DEF, which may be nil or omitted to disable persistent history
for top-level buffers that don't belong to any project."
:package-version '((sweeprolog "0.20.0"))
:type '(choice (const :tag "Disable persistent history" nil)
(cons :tag "File name relative to project root"
(const project) string)
(file :tag "History file name")
(function :tag "Function returning history file name")))
(defcustom sweeprolog-pack-description-max-width 80
"Maximum pack description width to display during completion.
This is an integer specifying a string width at which
`sweeprolog-pack-install' truncates pack descriptions annotating
pack completion candidates."
:package-version '((sweeprolog "0.22.2"))
:type 'natnum)
(defcustom sweeprolog-top-level-use-pty
(not (memq system-type '(ms-dos windows-nt)))
"Whether to communicate with top-levels using pseudo-terminal (\"pty\").
By default, this is t on systems where Emacs can use a pty."
:package-version '((sweeprolog "0.25.0"))
:type 'boolean)
;;;; Keymaps
(defvar-keymap sweeprolog-mode-map
:doc "Keymap for `sweeprolog-mode'."
"C-c C-b" #'sweeprolog-set-breakpoint
"C-c C-c" #'sweeprolog-analyze-buffer
"C-c C-d" #'sweeprolog-document-predicate-at-point
"C-c C-e" #'sweeprolog-export-predicate
"C-c TAB" #'sweeprolog-forward-hole
"C-c C-i" #'sweeprolog-forward-hole
"C-c <backtab>" #'sweeprolog-backward-hole
"C-c C-S-i" #'sweeprolog-backward-hole
"C-c C-l" #'sweeprolog-load-buffer
"C-c C-m" #'sweeprolog-insert-term-with-holes
"C-c C-o" #'sweeprolog-find-file-at-point
"C-c C-q" #'sweeprolog-top-level-send-goal
"C-c C-r" #'sweeprolog-rename-variable
"C-c C-S-s" #'sweeprolog-query-replace-term
"C-c C-s" #'sweeprolog-term-search
"C-c C-t" #'sweeprolog-top-level
"C-c C-u" #'sweeprolog-update-dependencies
"C-c C-`" #'sweeprolog-show-diagnostics
"C-c C-&" #'sweeprolog-async-goal
"C-c C-%" #'sweeprolog-make-example-usage-comment
"C-c C--" #'sweeprolog-decrement-numbered-variables
"C-c C-+" #'sweeprolog-increment-numbered-variables
"C-M-^" #'kill-backward-up-list
"C-M-m" #'sweeprolog-insert-term-dwim
"M-p" #'sweeprolog-backward-predicate
"M-n" #'sweeprolog-forward-predicate
"M-h" #'sweeprolog-mark-predicate)
(defvar-keymap sweeprolog-forward-hole-repeat-map
:doc "Repeat map for \\[sweeprolog-forward-hole]."
:repeat t
"TAB" #'sweeprolog-forward-hole
"C-i" #'sweeprolog-forward-hole
"<backtab>" #'sweeprolog-backward-hole
"C-S-i" #'sweeprolog-backward-hole
"C-m" #'sweeprolog-insert-term-with-holes)
(defvar-keymap sweeprolog-top-level-mode-map
:doc "Keymap for `sweeprolog-top-level-mode'."
"C-c C-c" #'sweeprolog-top-level-signal-current
"C-c C-i" #'sweeprolog-forward-hole)
(defvar-keymap sweeprolog-top-level-menu-mode-map
:doc "Local keymap for `sweeprolog-top-level-menu-mode' buffers."
"RET" #'sweeprolog-top-level-menu-go-to
"k" #'sweeprolog-top-level-menu-kill
"t" #'sweeprolog-top-level-menu-new
"s" #'sweeprolog-top-level-menu-signal)
(defvar-keymap sweeprolog-help-prefix-map
:doc "Keymap for `sweeprolog' help commands."
"m" #'sweeprolog-describe-module
"p" #'sweeprolog-describe-predicate
"e" #'sweeprolog-view-messages
"n" #'sweeprolog-view-news)
;;;###autoload (autoload 'sweeprolog-help-prefix-map "sweeprolog" nil t 'keymap)
(defalias 'sweeprolog-help-prefix-map sweeprolog-help-prefix-map)
(defvar-keymap sweeprolog-prefix-map
:doc "Keymap for `sweeprolog' global commands."
"B" #'sweeprolog-list-breakpoints
"F" #'sweeprolog-set-prolog-flag
"P" #'sweeprolog-pack-install
"R" #'sweeprolog-restart
"T" #'sweeprolog-list-top-levels
"X" #'sweeprolog-xref-project-source-files
"h" 'sweeprolog-help-prefix-map
"l" #'sweeprolog-load-buffer
"m" #'sweeprolog-find-module
"p" #'sweeprolog-find-predicate
"q" #'sweeprolog-top-level-send-goal
"t" #'sweeprolog-top-level
"&" #'sweeprolog-async-goal)
;;;###autoload (autoload 'sweeprolog-prefix-map "sweeprolog" nil t 'keymap)
(defalias 'sweeprolog-prefix-map sweeprolog-prefix-map)
(defvar-keymap sweeprolog-forward-hole-on-tab-mode-map
:doc "Keymap for moving to next hole with TAB."
"TAB" #'sweeprolog-indent-or-forward-hole)
(defvar-keymap sweeprolog-top-level-example-mode-map
:doc "Keymap for example top-level buffer."
"C-c C-b" #'sweeprolog-top-level-example-display-source
"C-c C-q" #'sweeprolog-top-level-example-done)
(defvar-keymap sweeprolog-read-term-map
:doc "Keymap used by `sweeprolog-read-term'."
:parent minibuffer-local-map
"C-m" #'sweeprolog-read-term-try
"C-j" #'sweeprolog-read-term-try)
(defvar-keymap sweeprolog-read-goal-map
:doc "Keymap used by `sweeprolog-goal-term'."
:parent sweeprolog-read-term-map
"C-i" #'completion-at-point)
;;;; Menu bar
(easy-menu-define sweeprolog-menu (list sweeprolog-mode-map
sweeprolog-top-level-mode-map)
"Sweep menu."
'("Sweep"
[ "Load Prolog Buffer" sweeprolog-load-buffer t ]
[ "Find Prolog Module" sweeprolog-find-module t ]
[ "Find Predicate" sweeprolog-find-predicate t ]
[ "Export Predicate"
sweeprolog-export-predicate
(and (eq major-mode 'sweeprolog-mode)
(sweeprolog-definition-at-point)) ]
[ "Insert Test-set Template"
sweeprolog-plunit-testset-skeleton
(derived-mode-p 'sweeprolog-mode) ]
[ "Insert Module Template"
auto-insert
(derived-mode-p 'sweeprolog-mode) ]
[ "Document Predicate"
sweeprolog-document-predicate-at-point
(and (derived-mode-p 'sweeprolog-mode)
(sweeprolog-definition-at-point)) ]
[ "Update Autoload Directives" sweeprolog-update-dependencies
(derived-mode-p 'sweeprolog-mode) ]
[ "Infer Indentation Style" sweeprolog-infer-indent-style
(derived-mode-p 'sweeprolog-mode) ]
[ "Search Term" sweeprolog-term-search
(derived-mode-p 'sweeprolog-mode)]
[ "Count Holes" sweeprolog-count-holes
(derived-mode-p 'sweeprolog-mode)]
"--"
[ "Set Prolog Flag" sweeprolog-set-prolog-flag t ]
[ "Install Prolog Package" sweeprolog-pack-install t ]
"--"
[ "Set Breakpoint" sweeprolog-set-breakpoint
(derived-mode-p 'sweeprolog-mode) ]
[ "Delete Breakpoint" sweeprolog-delete-breakpoint
(sweeprolog-current-breakpoints) ]
[ "List Breakpoints" sweeprolog-list-breakpoints t ]
"--"
[ "Open Top-level" sweeprolog-top-level t ]
[ "Signal Top-level"
sweeprolog-top-level-signal
(seq-filter (lambda (b)
(with-current-buffer b
(and (derived-mode-p 'sweeprolog-top-level-mode)
sweeprolog-top-level-thread-id)))
(buffer-list)) ]
[ "Send Goal to Top-level" sweeprolog-top-level-send-goal t ]
[ "Run Async Goal" sweeprolog-async-goal t ]
[ "Open Top-level Menu" sweeprolog-list-top-levels t ]
"--"
[ "Describe Predicate" sweeprolog-describe-predicate t ]
[ "Describe Prolog Module" sweeprolog-describe-module t ]
"--"
[ "Update Project Cross References"
sweeprolog-xref-project-source-files
(project-current) ]
"--"
[ "Reset Sweep" sweeprolog-restart t ]
[ "View Messages" sweeprolog-view-messages t ]
[ "Read the Sweep Manual" sweeprolog-info-manual t ]
[ "Sweep News" sweeprolog-view-news t ]
[ "Report Bug" sweeprolog-submit-bug-report t ]))
;;;; Local variables
(defvar-local sweeprolog--diagnostics nil)
(defvar-local sweeprolog--diagnostics-report-fn nil)
(defvar-local sweeprolog--timer nil)
(defvar-local sweeprolog--analyze-buffer-duration 0.2)
(defvar-local sweeprolog--html-footnotes nil)
(defvar-local sweeprolog-top-level-thread-id nil
"Prolog top-level thread ID corresponding to this buffer.")
(defvar-local sweeprolog-top-level-example-marker nil)
(defvar-local sweeprolog--buffer-last-modified-time nil)
(defvar-local sweeprolog--buffer-modified nil)
(defvar-local sweeprolog--analyze-point nil)
;;;; Declarations for functions defined in `sweep-module'
(declare-function sweeprolog-initialize "sweep-module")
(declare-function sweeprolog-initialized-p "sweep-module")
(declare-function sweeprolog-open-query "sweep-module")
(declare-function sweeprolog-next-solution "sweep-module")
(declare-function sweeprolog-cut-query "sweep-module")
(declare-function sweeprolog-close-query "sweep-module")
(declare-function sweeprolog-cleanup "sweep-module")
;;;; Initialization
(defun sweeprolog--load-module (line)
"Load the dynamic module that LINE describes."
(save-match-data
(when (string-match (rx bos
(or "L" "M")
(one-or-more whitespace)
(group-n 1 (one-or-more not-newline))
eos)
line)
(module-load (match-string 1 line)))))
(defun sweeprolog--ensure-module ()
"Locate and load `sweep-module', unless already loaded."
(unless (featurep 'sweep-module)
(let ((sweep-pl (expand-file-name
"sweep.pl"
sweeprolog--directory)))
(unless (file-readable-p sweep-pl)
(error "Missing file `sweep.pl' in `sweeprolog' directory"))
(let* ((success nil)
(lines (process-lines-handling-status
(or sweeprolog-swipl-path "swipl")
(lambda (status)
(setq success (= status 0)))
"-q" "-g" "write_sweep_module_location"
"-t" "halt"
sweep-pl)))
(if (and success lines)
(mapc #'sweeprolog--load-module lines)
(error (concat "Failed to locate `sweep-module'. "
"Make sure SWI-Prolog is installed "
"and up to date")))))))
(defun sweeprolog-ensure-initialized ()
"Initilize Prolog, unless already initilized."
(sweeprolog--ensure-module)
(sweeprolog-init))
(defun sweeprolog-init (&rest args)
"Initialize and setup the embedded Prolog runtime.
If specified, ARGS should be a list of string passed to Prolog as
extra initialization arguments."
(unless sweeprolog--initialized
(message "Starting Sweep.")
(apply #'sweeprolog-initialize
(cons (or sweeprolog-swipl-path (executable-find "swipl"))
(append sweeprolog-init-args
(append sweeprolog--extra-init-args
args))))
(setq sweeprolog--initialized t)
(add-hook 'kill-emacs-query-functions #'sweeprolog-maybe-kill-top-levels)
(add-hook 'kill-emacs-hook #'sweeprolog--shutdown)
(sweeprolog-setup-message-hook)))
(defun sweeprolog-maybe-kill-top-levels ()
"Ask before killing running Prolog top-levels."
(let ((top-levels (seq-filter (lambda (buffer)
(with-current-buffer buffer
(and (derived-mode-p 'sweeprolog-top-level-mode)
sweeprolog-top-level-thread-id)))
(buffer-list))))
(or (not top-levels)
(and (let ((num (length top-levels)))
(y-or-n-p (if (< 1 num)
(format "Stop %d running Sweep top-levels?" num)
"Stop running Sweep top-level?")))
(prog1 t
(dolist (buffer top-levels)
(sweeprolog-top-level-delete-process buffer)))))))
(defun sweeprolog--shutdown ()
"Shutdown Prolog."
(message "Stopping Sweep.")
(sweeprolog--query-once "sweep" "sweep_cleanup_threads" nil)
(sweeprolog-cleanup)
(setq sweeprolog--initialized nil
sweeprolog-prolog-server-port nil))
(defun sweeprolog-shutdown ()
"Ask before killing running top-levels and shutdown Prolog."
(interactive)
(if (sweeprolog-maybe-kill-top-levels)
(sweeprolog--shutdown)
(user-error "Cannot restart Sweep with running top-levels")))
(defun sweeprolog-restart (&rest args)
"Restart the embedded Prolog runtime.
ARGS is a list of strings appended to the value of
`sweeprolog-init-args' to produce the Prolog initialization
arguments.
Interactively, with a prefix arguments, prompt for ARGS.
Otherwise set ARGS to nil."
(interactive
(and
current-prefix-arg
(fboundp 'split-string-shell-command)
(split-string-shell-command (read-string "swipl arguments: "))))
(sweeprolog-shutdown)
(progn
(sit-for 1)
(apply #'sweeprolog-init args)))
(defun sweeprolog--open-query (ctx mod fun arg &optional rev)
"Ensure that Prolog is initialized and execute a new query.
CTX, MOD and FUN are strings. CTX is the context Prolog module
in which the query in invoked. MOD is the Prolog module in which
the invoked predicate is defined. FUN is the functor of the
invoked predicate.
ARG is converted to a Prolog term and used as the input argument
for the query. When REV is a nil, the input argument is the
first argument, and the output argument is second. Otherwise,
the order of the arguments is reversed."
(sweeprolog-ensure-initialized)
(sweeprolog-open-query ctx mod fun arg rev))
(define-error 'prolog-exception "Prolog exception")
(defun sweeprolog--query-once (mod pred arg &optional rev)
(sweeprolog--open-query "user" mod pred arg rev)
(let ((sol (sweeprolog-next-solution)))
(sweeprolog-close-query)
(pcase sol
(`(exception . ,exception-term)
(signal 'prolog-exception exception-term))
(`(,_ . ,result) result))))
(defun sweeprolog-start-prolog-server ()
"Start the Sweep Prolog top-level embedded server."
(setq sweeprolog-prolog-server-port
(sweeprolog--query-once "sweep" "sweep_top_level_server" nil)))
(defun sweeprolog-setup-message-hook ()
"Setup `thread_message_hook/3' to redirecet Prolog messages."
(with-current-buffer (get-buffer-create sweeprolog-messages-buffer-name)
(setq-local window-point-insertion-type t)
(compilation-minor-mode 1))
(sweeprolog--query-once "sweep" "sweep_setup_message_hook" nil))
;;;; Prolog messages
(defun sweeprolog-view-messages ()
"View the log of recent Prolog messages."
(interactive)
(with-current-buffer (get-buffer-create sweeprolog-messages-buffer-name)
(goto-char (point-max))
(let ((win (display-buffer (current-buffer))))
(set-window-point win (point))
win)))
(defun sweeprolog-message (message)
"Emit the Prolog message MESSAGE to the Sweep messages buffer."
(with-current-buffer (get-buffer-create sweeprolog-messages-buffer-name)
(save-excursion
(goto-char (point-max))
(let ((kind (car message))
(content (cdr message)))
(pcase kind
(`("debug" . ,topic)
(insert (propertize "DEBUG" 'face 'sweeprolog-debug-prefix))
(insert "[")
(insert (propertize topic 'face 'sweeprolog-debug-topic))
(insert "]: ")
(insert content))
("informational"
(insert (propertize "INFO" 'face 'sweeprolog-info-prefix))
(insert ": ")
(insert content))
("warning"
(insert (propertize "WARNING" 'face 'sweeprolog-warning-prefix))
(insert ": ")
(insert content))
("error"
(insert (propertize "ERROR" 'face 'sweeprolog-error-prefix))
(insert ": ")
(insert content))))
(newline))))
;;;; Flags
(defun sweeprolog-current-prolog-flags (&optional prefix)
"Return the list of defined Prolog flags defined with prefix PREFIX."
(sweeprolog--query-once "sweep" "sweep_current_prolog_flags" (or prefix "")))
(defun sweeprolog-read-prolog-flag ()
"Read a Prolog flag from the minibuffer, with completion."
(let* ((col (sweeprolog-current-prolog-flags))
(completion-extra-properties
(list :annotation-function
(lambda (key)
(let* ((val (cdr (assoc-string key col))))
(if val
(concat (make-string
(max (- 32 (length key)) 1) ? )
val)
nil))))))
(completing-read sweeprolog-read-flag-prompt col)))
(defun sweeprolog-set-prolog-flag (flag value)
"Set the Prolog flag FLAG to VALUE.
FLAG and VALUE are specified as strings and read as Prolog terms."
(interactive (let ((f (sweeprolog-read-prolog-flag)))
(list f (read-string (concat "Set " f " to: ")))))
(if (sweeprolog--query-once "sweep" "sweep_set_prolog_flag" (cons flag value))
(message "Prolog flag %s set to %s" flag value)
(user-error "Setting %s to %s failed!" flag value)))
;;;; Predicates
(defun sweeprolog-predicates-collection (&optional prefix)
"Return a list of predicate completion candidates matchitng PREFIX."
(sweeprolog--query-once "sweep" "sweep_predicates_collection" prefix))
;;;###autoload
(defun sweeprolog-xref-project-source-files (&optional project)
"Update cross reference data for all Prolog files in PROJECT.
If PROJECT is nil, update data for the current project.
If called interactively with a prefix argument, prompt for
PROJECT (only on Emacs 28 or later)."
(interactive (list (or (and current-prefix-arg
(fboundp 'project-prompt-project-dir)
(let ((default-directory
(project-prompt-project-dir)))
(project-current)))
(or (project-current)
(user-error "No current project")))))
(when-let ((proj (or project (project-current)))
(files (seq-filter
(lambda (path)
(string= "pl" (file-name-extension path)))
(project-files proj))))
(dolist-with-progress-reporter
(file (seq-filter (lambda (file)
(string= "pl" (file-name-extension file)))
(project-files proj)))
"Analyzing Prolog files in project... "
(sweeprolog--query-once "sweep" "sweep_xref_source" file))))
(defun sweeprolog-predicate-references (mfn)
"Find source locations where the predicate MFN is called."
(sweeprolog-xref-project-source-files)
(sweeprolog--query-once "sweep" "sweep_predicate_references" mfn))
(defun sweeprolog--pi-to-functor-arity (mfn)
(pcase (sweeprolog--query-once "system" "term_string" mfn t)
(`(compound ":"
(atom . ,_)
(compound "/"
(atom . ,functor)
,arity))
(cons functor arity))
(`(compound "/"
(atom . ,functor)
,arity)
(cons functor arity))
(`(compound ":"
(atom . ,_)
(compound "//"
(atom . ,functor)
,arity))
(cons functor (+ arity 2)))
(`(compound "//"
(atom . ,functor)
,arity)
(cons functor (+ arity 2)))))
(defun sweeprolog--swipl-source-directory ()
(when sweeprolog-swipl-sources
(if (stringp sweeprolog-swipl-sources)
sweeprolog-swipl-sources
(when (fboundp 'project-known-project-roots)
(car (seq-filter
(lambda (root)
(member (file-name-base (directory-file-name root))
'("swipl" "swipl-devel")))
(project-known-project-roots)))))))
(defun sweeprolog-native-predicate-location (mfn)
(let ((functor-arity (sweeprolog--pi-to-functor-arity mfn)))
(when-let ((default-directory (sweeprolog--swipl-source-directory))
(match
(car (xref-matches-in-files
(rx (or "PRED_IMPL" "FRG")
(zero-or-more whitespace)
"(\""
(zero-or-more whitespace)
(literal (car functor-arity))
"\""
(zero-or-more whitespace)
","
(zero-or-more whitespace)
(literal (number-to-string (cdr functor-arity))))
(project-files (project-current)
(list (expand-file-name "src"
default-directory))))))
(location (if (fboundp 'xref-match-item-location)
(xref-match-item-location match)
(xref-item-location match))))
(if (fboundp 'xref-file-location-file)
(cons (xref-file-location-file location)
(xref-file-location-line location))
(with-slots ((file file)
(line line))
location
(cons file line))))))
(defun sweeprolog-predicate-location (mfn)
"Return the source location where the predicate MFN is defined.
For native built-in predicates, the behavior of this function
depends on the value of the user option
`sweeprolog-swipl-sources', which see."
(or (sweeprolog--query-once "sweep" "sweep_predicate_location" mfn)
(sweeprolog-native-predicate-location mfn)))
(defun sweeprolog-predicate-apropos (pattern)
"Return a list of predicates whose name resembeles PATTERN."
(sweeprolog--query-once "sweep" "sweep_predicate_apropos" pattern))
(defun sweeprolog-read-functor (&optional arity)
"Read a Prolog functor/arity pair from the minibuffer.
If ARITY is nil, prompt for the arity after reading the functor.
Otherwise, read only the functor, with completion candidates are
restricted to functors with arity ARITY, and return ARITY as the
arity.
Return a cons cell of the functor as a string and the arity."
(let* ((col (sweeprolog--query-once "sweep" "sweep_current_functors"