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

;; Copyright (C) 2005, 2006, 2007  Johan Bockgård
;; Time-stamp: <2007-06-16 11:57:48 bojohan>

;; Author: Johan Bockgård <bojohan+mail@dd.chalmers.se>
;; Keywords: languages

;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;; Major mode for editing GF code, with support for running a GF
;; shell.

;;; Usage:

;; To use this library, put it somewhere Emacs can find it (in
;; `load-path') and add the following lines to your .emacs file.

;; (autoload 'run-gf "gf" nil t)
;; (autoload 'gf-mode "gf" nil t)
;; (add-to-list 'auto-mode-alist '("\\.gf\\(\\|e\\|r\\|cm?\\)\\'" . gf-mode))
;; (add-to-list 'auto-mode-alist '("\\.cf\\'" . gf-mode))
;; (add-to-list 'auto-mode-alist '("\\.ebnf\\'" . gf-mode))

;;; History:

;; 2006-10-30:
;;   	 let a = b
;;   	     c = d ...
;;   	 in ...
;;   indentation now works (most of the time).

;;; Code:

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

(defgroup gf nil
  "Support for GF (Grammatical Framework)"
  :group 'languages
  ;; :link  '(emacs-commentary-link "gf")
  :link  '(url-link "http://www.cs.chalmers.se/~aarne/GF/"))

(defvar gf-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map "\C-c\C-l"  'gf-load-file)
    (define-key map "\C-c\C-b"  'gf-display-inf-buffer)
    (define-key map "\C-c\C-s"  'run-gf)
    (define-key map (kbd "DEL") 'backward-delete-char-untabify)
    map)
  "Keymap for `gf-mode'.")

;; Taken from haskell-mode
(defvar gf-mode-syntax-table
  (let ((table (make-syntax-table)))
    (modify-syntax-entry ?\   " "  table)
    (modify-syntax-entry ?\t  " "  table)
    (modify-syntax-entry ?\"  "\"" table)
    (modify-syntax-entry ?\'  "\'" table)
    (modify-syntax-entry ?_   "w"  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)

    (cond ((featurep 'xemacs)
	   ;; I don't know whether this is equivalent to the below
	   ;; (modulo nesting).  -- fx
	   (modify-syntax-entry ?{  "(}5" table)
	   (modify-syntax-entry ?}  "){8" table)
	   (modify-syntax-entry ?-  "_ 1267" table))
	  (t
	   ;; The following get comment syntax right, similarly to C++
	   ;; In Emacs 21, the `n' indicates that they nest.
	   ;; The `b' annotation is actually ignored because it's only
	   ;; meaningful on the second char of a comment-starter, so
	   ;; on Emacs 20 and before we get wrong results.  --Stef
	   (modify-syntax-entry ?\{  "(}1nb" table)
	   (modify-syntax-entry ?\}  "){4nb" table)
	   (modify-syntax-entry ?-  "_ 123" table)))
    (modify-syntax-entry ?\n ">" table)

    (let (i lim)
      (map-char-table
       (lambda (k v)
	 (when (equal v '(1))
	   ;; The current Emacs 22 codebase can pass either a char
	   ;; or a char range.
	   (if (consp k)
	       (setq i (car k)
		     lim (cdr k))
	     (setq i k
		   lim k))
	   (while (<= i lim)
	     (when (> i 127)
	       (modify-syntax-entry i "_" table))
	     (setq i (1+ i)))))
       (standard-syntax-table)))

    (modify-syntax-entry ?\` "$`" table)
    (modify-syntax-entry ?\\ "\\" table)
    (mapcar (lambda (x)
	      (modify-syntax-entry x "_" table))
	    ;; Some of these are actually OK by default.
	    "!#$%&*+./:=?@^|~")
    (unless (featurep 'mule)
      ;; Non-ASCII syntax should be OK, at least in Emacs.
      (mapcar (lambda (x)
		(modify-syntax-entry x "_" table))
	      (concat "¡¢£¤¥¦§¨©ª«¬­®¯°±²³´µ¶·¸¹º»¼½¾¿"
		      "×÷"))
      (mapcar (lambda (x)
		(modify-syntax-entry x "w" table))
	      (concat "ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ"
		      "ØÙÚÛÜÝÞß"
		      "àáâãäåæçèéêëìíîïðñòóôõö"
		      "øùúûüýþÿ")))
    table)
  "Syntax table used in GF mode.")

;; Lin         PType     Str        Strs       Tok        Type
;; abstract    case      cat        concrete   data       def
;; flags       fn        fun        grammar    in         include
;; incomplete  instance  interface  let        lin        lincat
;; lindef      lintype   of         open       oper       out
;; package     param     pattern    pre        printname  resource
;; reuse       strs      table      tokenizer  transfer   union
;; var         variants  where      with
;;   ; = { } ( ) : -> ** , [ ] - . | % ? < > @ ! * \ => ++ + _ $ /

;; Judgements
(defvar gf-top-level-keywords
  '("cat" "fun" "lincat" "lintype" "lin" "pattern"
    "oper" "def" "param" "flags" "lindef" "printname"
    "data" "transfer"
    ))

(defvar gf-module-keywords
  '("abstract" "concrete" "resource" "instance" "interface"))

(defvar gf-keywords
  (append '("of" "let" "include" "open" "in" "where"
	    "with" "case" "incomplete" "table"
	    "variants" "pre" "strs" "overload")
	  gf-top-level-keywords
	  gf-module-keywords))

(defvar gf-top-level-keyword-regexp (regexp-opt gf-top-level-keywords 'words))
(defvar gf-keyword-regexp (regexp-opt gf-keywords 'words))

(defvar gf-font-lock-keywords
  (let ((sym "\\(\\s_\\|\\\\\\)+")
	;; (keyw gf-keyword-regexp)
	(mod (concat (regexp-opt gf-module-keywords 'words)
		     "\\s-\\(\\w+\\)"))
	(pface '(if (boundp 'font-lock-preprocessor-face)
		    font-lock-preprocessor-face
		  font-lock-builtin-face)))
    `(;; Module
      (,mod (1 font-lock-keyword-face)
	    (2 font-lock-type-face))
      ;; Keywords
      (,(lambda (end)
	  (let (parse-sexp-lookup-properties)
	    (re-search-forward gf-keyword-regexp end t)))
       . font-lock-keyword-face)
      ;; Operators
      (,sym  . font-lock-variable-name-face)
      ;; Pragmas
      ("^--\\(#.*\\)" (1 ,pface prepend))
      ("--\\(#\\s-*\\(notpresent\\|prob\\).*\\)" (1 ,pface prepend))
      ;; GFDoc
      ("^--[0-9]+\\s-*\\(.*\\)" (1 'underline prepend))
      ("^--\\([*!.]\\)"         (1 'underline prepend))
      (,(lambda (end)
	  (let (found)
	    (while
		(and (setq found (re-search-forward
				  ;; "\\$.*?\\$\\|\\*.*?\\*\\|\".*?\""
				  "\\$.*?\\$"
				  end t))
		     (not (eq (get-text-property (match-beginning 0) 'face)
			      'font-lock-comment-face))))
	    found))
       (0 (if (face-italic-p 'font-lock-comment-face)
	      '((:slant normal))
	    '((:slant italic)))
	  prepend))
      ;; Types (?)
      ;; ("[^.]\\(\\<[[:upper:]]\\w*\\)[^.]" 1 font-lock-type-face)
      ))
  "Keyword highlighting specification for `gf-mode'.")

(defcustom gf-let-brace-style t
  "The let...in style to use for indentaton.

A value of t means unbraced (new) style:


     let x = a;
         y = b; in ...

A value of nil means braced (old) style

     let { x = a;
           y = b; } in ...

Anything else means try to guess."
  :type '(choice (const :tag "Unbraced"  t)
		 (const :tag "Braced"    nil)
		 (const :tag "Heuristic" 'heuristic))
  :group 'gf)

;; let x = let a = f;
;;             b = g;
;;       in b;
;;     y = d;
;;   in h
(defun gf-match-let/in (let/in end)
  (when gf-let-brace-style
    (if (eq 'let let/in)
	(and (re-search-forward "\\<le\\(t\\)\\>" end t)
	     (or (eq t gf-let-brace-style)
		 (save-excursion
		   (skip-syntax-forward " ")
		   (not (eq ?\{ (char-after))))))
      (and (re-search-forward "\\<\\(i\\)n\\>" end t)
	   (or (eq t gf-let-brace-style)
	       (save-excursion
		 (backward-char 2)
		 (skip-syntax-backward " ")
		 (not (eq ?\} (char-before)))))))))

(defvar gf-font-lock-syntactic-keywords
  `(;; let ...
    (,(lambda (end) (gf-match-let/in 'let end))
     1 "(")
    ;; ;; open ...
    ;; (,(lambda (end)
    ;; 	(and (re-search-forward "\\<ope\\(n\\)\\>" end t)
    ;; 	     (save-excursion
    ;; 	       (skip-syntax-forward " ")
    ;; 	       (not (eq ?\{ (char-after))))))
    ;;  1 "(")
    ;; ... in
    (,(lambda (end) (gf-match-let/in 'in end))
     1 ")")
    ))

 ;; (defvar gf-imenu-generic-expression
 ;;   ...)

 ;; (defvar gf-outline-regexp
 ;;   ...)

;;;###autoload
(define-derived-mode gf-mode fundamental-mode "GF"
  "A major mode for editing GF files."
  ;; (set (make-local-variable 'imenu-generic-expression)
  ;;      gf-imenu-generic-expression)
  ;; (set (make-local-variable 'outline-regexp) sample-outline-regexp)
  (set (make-local-variable 'comment-start) "-- ")
  (set (make-local-variable 'comment-start-skip) "[-{]-[ \t]*")
  (set (make-local-variable 'font-lock-defaults)
       '(gf-font-lock-keywords
	 nil nil nil nil
	 (font-lock-syntactic-keywords . gf-font-lock-syntactic-keywords)
	 ))
  (set (make-local-variable 'indent-line-function) 'gf-indent-line)
  (set (make-local-variable 'eldoc-documentation-function) 'gf-doc-display)
  (set (make-local-variable 'beginning-of-defun-function)
       'gf-beginning-of-section)
  (set (make-local-variable 'end-of-defun-function)
       'gf-end-of-section))

;;; Indentation
(defcustom gf-indent-basic-offset 2
  "*Number of columns to indent in GF mode."
  :type 'integer
  :group 'gf)

(defcustom gf-indent-judgment-offset 2
  "*Column where judement should be indented to."
  :type 'integer
  :group 'gf)

(defun gf-indent-line ()
  "Indent current line of GF code."
  (interactive)
  (save-excursion
    (font-lock-fontify-syntactic-keywords-region
     (point-at-bol) (point-at-bol)))
  (let* ((case-fold-search nil)
	 (parse-sexp-lookup-properties t)
	 (parse-sexp-ignore-comments t)
	 (savep (> (current-column) (current-indentation)))
	 (indent (condition-case err
		     (max (gf-calculate-indentation) 0)
		   (error (message "%s" err) 0))))
    (if savep
	(save-excursion (indent-line-to indent))
      (indent-line-to indent))))

(defun gf-beginning-of-section ()
  (when (re-search-backward
	 (concat "^\\s-*" gf-top-level-keyword-regexp)
	 nil 'move)
    (goto-char (match-beginning 0)))
  (point))

(defun gf-end-of-section ()
  (gf-forward-comment)
  (when (looking-at gf-top-level-keyword-regexp)
    (goto-char (match-end 0)))
  (when (re-search-forward
	 (concat "^\\s-*" gf-top-level-keyword-regexp)
	 (condition-case nil
	     (1- (scan-lists (point) 1 1))
	   (error nil))
	 'move)
    (goto-char (match-beginning 0)))
  (gf-backward-comment)
  (point))

;; (defun gf-beginning-of-defun ()
;;   (let* ((beg (save-excursion (gf-beginning-of-section) (point)))
;; 	 (end (save-excursion (progn (forward-line 0) (point))))
;; 	 (pps (parse-partial-sexp beg end)))
;;     (when (nth 1 pps) (backward-up-list (nth 0 pps)))
;;     (back-to-indentation)
;;     (point)))

(defun gf-beginning-of-sequence (&optional keep-going limit)
  (or limit (let ((com-start (gf-in-comment-p)))
	      (when com-start
		(save-excursion
		  (goto-char com-start)
		  (skip-chars-forward "{")
		  (skip-chars-forward "-")
		  (setq limit (point))))))
  (let* ((str "[;]")
	 (found-it nil)
	 (pps   (gf-ppss))
	 (depth (or (nth 0 pps) 0))
	 (bol   (point-at-bol))
	 (lim   (max (or limit (point-min))
		     (if (nth 1 pps)
			 (1+ (nth 1 pps))
		       (save-excursion
			 (gf-beginning-of-section)
			 (when (looking-at
				(concat "\\s-*" gf-top-level-keyword-regexp))
			   (goto-char (match-end 0))
			   (gf-forward-comment))
			 (point))))))
    (while (and (> (point) lim)
		(setq found-it (re-search-backward str lim 'move))
		(let ((pps (gf-ppss)))
		  (or (/= depth (nth 0 pps))
		      (nth 3 pps)
		      (nth 4 pps)))))
    (when found-it
      (when keep-going
	(setq lim (max lim bol))
	(while (and (> (point) lim)
		    (setq found-it (re-search-backward str lim 'move))
		    ;;(/= depth (nth 0 (gf-ppss)))
		    )))
      (when found-it (forward-char)))))

(defun gf-in-comment-p ()
  (let ((pps (gf-ppss)))
    (and (nth 4 pps) (nth 8 pps))))

(defun gf-forward-comment () (forward-comment (buffer-size)))
(defun gf-backward-comment ()
  (forward-comment (- (buffer-size)))
  ;; (while (or (not (zerop (skip-chars-backward " \t\n")))
  ;; 	     (let  ((start (gf-in-comment)))
  ;; 	       (and start (goto-char start)))))
  )


(defun gf-ppss ();; (&optional from to)
  (parse-partial-sexp
   (save-excursion (gf-beginning-of-section))
   (point)))

(if (fboundp 'syntax-after)
    (defalias 'gf-syntax-after 'syntax-after)
  (defun gf-syntax-after (pos)
    "Return the raw syntax of the char after POS.
If POS is outside the buffer's accessible portion, return nil."
    (unless (or (< pos (point-min)) (>= pos (point-max)))
      (let ((st (if parse-sexp-lookup-properties
		    (get-char-property pos 'syntax-table))))
	(if (consp st) st
	  (aref (or st (syntax-table)) (char-after pos)))))))

(if (fboundp 'syntax-class)
    (defalias 'gf-syntax-class 'syntax-class)
  (defun gf-syntax-class (syntax)
    "Return the syntax class part of the syntax descriptor SYNTAX.
If SYNTAX is nil, return nil."
    (and syntax (logand (car syntax) 65535))))

(defun gf-calculate-indentation ()
  "Return the column to which the current line should be indented."
  (save-excursion
    (forward-line 0)
    (skip-chars-forward " \t")
    (cond
     ;; judgement
     ((looking-at gf-top-level-keyword-regexp)
      gf-indent-judgment-offset)
     ((and gf-let-brace-style
	   (looking-at "in\\>"))
      (if (condition-case nil
	      (progn (backward-up-list)
		     nil)
	    (error t))
	  gf-indent-basic-offset
	(gf-beginning-of-sequence)
	(if (= (point) (point-min))
	    0
	  (gf-forward-comment)
	  (+ gf-indent-basic-offset (current-column)))))
     ((looking-at "[]})]")
      ;; (looking-at "[]})]")
      ;; (eq 5 (gf-syntax-class (gf-syntax-after (point))))
      (backward-up-list)
      (gf-beginning-of-sequence)
      (if (= (point) (point-min))
	  0
	(gf-forward-comment)
	(+ gf-indent-basic-offset (current-column))))
     ;; heading
     ((looking-at "---")
      (gf-beginning-of-sequence)
      (if (= (point) (point-min))
	  0
	gf-indent-judgment-offset))
     (t
      (let ((opoint (point)))
	(gf-backward-comment)
	(cond
	  ((eq  ?\; (char-before))
	   ;; ?\,
	   (backward-char)
	   (gf-beginning-of-sequence t)
	   (gf-forward-comment)
	   (current-column))
	  (;; (memq (char-before) '( ?\{ ?\[ ?\( ;; ?\<
	   ;; 			      ))
	   (eq 4 (gf-syntax-class (gf-syntax-after (1- (point)))))
	   (backward-char)
	   ;; alt. (gf-beginning-of-sequence nil nil)
	   (gf-beginning-of-sequence nil (point-at-bol))
	   (gf-forward-comment)
	   ;; alt. (+ (* 2 gf-indent-basic-offset) (current-column)))
	   (+ gf-indent-basic-offset (current-column)))
	  (t
	   (gf-beginning-of-sequence)
	   (let ((head (= (point) (point-min))))
	     (gf-forward-comment)
	     (cond
	      ;; ((< opoint (point)) 0)
	      ((> opoint (point)) (+ gf-indent-basic-offset (current-column)))
	      ;; i.e. opoint == (point)
	      (head 0)
	      (t    (gf-beginning-of-section)
		    (skip-chars-forward " \t")
		    (+ gf-indent-basic-offset (current-column))))))))))))

(defun gf-load-file ()
  (interactive)
  (start-gf)
  (comint-send-string gf-process (format "i %s\n" buffer-file-name))
  (gf-clear-lang-cache)
  (gf-display-inf-buffer))

(defun gf-display-inf-buffer ()
  (interactive)
  (and (get-buffer gf-process-buffer-name)
       (display-buffer gf-process-buffer-name)))

;; Inferior GF Mode ----------------

(defcustom gf-program-name "gf"
  "*Name of GF shell invoked by `run-gf'."
  :type 'file
  :group 'gf)
(defvar gf-program-args nil "*Arguments passed to GF by `run-gf'.")
(defvar gf-process-buffer-name "*gf*")
(defvar gf-process)

(require 'comint)

(define-derived-mode inf-gf-mode comint-mode "Inf-GF"
  (gf-setup-pcomplete))

(define-key inf-gf-mode-map "\t" 'gf-complete)

;;;###autoload
(defun run-gf ()
  "Run an inferior GF process."
  (interactive)
  (start-gf)
  (pop-to-buffer gf-process-buffer-name))

(defun start-gf ()
  (unless (comint-check-proc gf-process-buffer-name)
    (with-current-buffer
	(apply 'make-comint-in-buffer
	       "gf" gf-process-buffer-name gf-program-name
	       nil gf-program-args)
      (setq gf-process (get-buffer-process (current-buffer)))
      (set-buffer-process-coding-system 'latin-1-unix 'latin-1-unix)
      (inf-gf-mode))))

;; (defun gf-norm-func (string)
;;   (if (string-match "\\(.*\\)\\(=[^=]*\\)" string)
;;       (match-string 1 string)
;;     string))

;; (defmacro gf-pcomplete-here (&optional form stub paring form-only)
;;   `(pcomplete-here ,form ,stub (or ,paring 'gf-norm-func) ,form-only))
;; (put 'gf-pcomplete-here 'edebug-form-spec t)

(put 'pcomplete-here 'edebug-form-spec t)

(defun gf-setup-pcomplete ()
  (set (make-local-variable 'comint-prompt-regexp) "^[^>\n]*> *")
  (set (make-local-variable 'pcomplete-ignore-case) nil)
  (set (make-local-variable 'pcomplete-use-paring)  t)
  (set (make-local-variable 'pcomplete-suffix-list) '(?/ ?=))
  ;; (set (make-local-variable 'comint-dynamic-complete-functions)
  ;;      (add-to-list 'comint-dynamic-complete-functions 'pcomplete))
  (set (make-local-variable 'pcomplete-parse-arguments-function)
       'gf-parse-arguments)
  (set (make-local-variable 'pcomplete-command-completion-function)
       'gf-complete-command)
  ;; (set (make-local-variable 'pcomplete-command-name-function)
  ;;      'pcomplete-erc-command-name)
  (set (make-local-variable 'pcomplete-default-completion-function)
       'gf-default-completion-function)
  (add-hook 'comint-input-filter-functions
	    'gf-watch-for-loading
	    nil t))

(defun gf-watch-for-loading (string)
  (when (string-match (concat "\\(\\`\\||\\;;\\)\\s-*"
			      (regexp-opt '("i" "e" "rl") 'words))
		      string)
    (gf-clear-lang-cache)))

(defun gf-parse-arguments ()
  "Parse whitespace separated arguments in the current region."
  (let ((begin (save-excursion
		 ;; (parse-partial-sexp begin end)
		 (if (re-search-backward "|\\|;;" (point-at-bol) t)
		     (match-end 0)
		   (comint-bol nil)
		   (point))))
	(end (point))
	begins args)
    (save-excursion
      (goto-char begin)
      (while (< (point) end)
	(skip-chars-forward " \t\n")
	(setq begins (cons (point) begins))
	(let ((skip t))
	  (while skip
	    (skip-chars-forward "^ \t\n")
	    (if (eq (char-before) ?\\)
		(skip-chars-forward " \t\n")
	      (setq skip nil))))
	(setq args (cons (buffer-substring-no-properties
			  (car begins) (point))
			 args)))
      (cons (reverse args) (reverse begins)))))

(defun gf-complete ()
  (interactive)
  ;; (setq this-command 'pcomplete)
  (pcomplete))

(defun gf-default-completion-function ()
  (pcomplete-here (pcomplete-entries)))

(defun gf-complete-command ()
  (pcomplete-here (gf-complete-commands)))

(defun gf-complete-commands () gf-short-command-names)

;; (defun gf-complete-flagify (flags)
;;   (mapcar (lambda (s) (concat s "=")) flags))

(defvar gf-short-command-names
  '("i" "rl" "e" "sf" "s" "pg" "pm" "vg" "po" "pl" "pi"
    "eh" "ph" "l" "p" "tt" "cc" "so" "t" "gr" "gt" "ma"
    "ps" "pt" "st" "wt" "vt" "es" "ts" "tq" "tl" "mq"
     "ml" "rf" "wf" "af" "tg" "cl" "sa" "h" "q" "!"))

(defvar gf-long-command-names
  '("import" "remove_language" "empty" "set_flags" "strip"
    "print_grammar" "print_multigrammar" "visualize_graph"
    "print_options" "print_languages" "print_info"
    "execute_history" "print_history" "linearize" "parse" "test_tokenizer"
    "compute_concrete" "show_operations" "translate" "generate_random"
    "generate_trees" "morphologically_analyse" "put_string" "put_tree"
    "show_tree" "wrap_tree" "visualize_tree" "editing_session"
    "translation_session" "translation_quiz" "translation_list"
    "morphology_quiz" "morphology_list" "read_file" "write_file"
    "append_file" "transform_grammar" "convert_latex" "speak_aloud"
    "help" "quit" "system_command"))

(defun gf-complete-options (options flags &optional flags-extra-table
				    extra-completions)
  (let ((-options (mapcar (lambda (s) (concat "-" s)) options))
	(-flags= (mapcar (lambda (s) (concat "-" s "=")) flags)))
    ;; do-while
    (while (progn
	     (cond
	      ((pcomplete-match "\\`-\\(\\w+\\)=\\(.*\\)" 0)
	       (pcomplete-here
		(let ((opt (cdr (assoc (car (member
					     (pcomplete-match-string 1 0)
					     flags))
				       (append flags-extra-table
					       gf-flags-table)))))
		  (if (functionp opt)
		      (funcall opt)
		    opt))
		(pcomplete-match-string 2 0)))
	      (t (pcomplete-here
		  (append
		   (if (functionp extra-completions)
		       (funcall extra-completions)
		     extra-completions)
		   -options -flags=))))
	     (pcomplete-match "\\`-" 1)))))

(defun gf-collect-results (process command function)
  (let ((output-buffer " *gf-tmp*")
	results)
    (save-excursion
      (set-buffer (get-buffer-create output-buffer))
      (erase-buffer)
      (comint-redirect-send-command-to-process
       command output-buffer process nil t)
      ;; Wait for the process to complete
      (set-buffer (process-buffer process))
      (while (null comint-redirect-completed)
	(accept-process-output nil 1))
      ;; Collect the output
      (set-buffer output-buffer)
      (goto-char (point-min))
      ;; Skip past the command, if it was echoed
      (and (looking-at command) (forward-line))
      (funcall function))))

;; Command Completion ---------------------------------------------

;; i,  import: i File
;;       Reads a grammar from File and compiles it into a GF runtime grammar.
;;       Files "include"d in File are read recursively, nubbing repetitions.
;;       If a grammar with the same language name is already in the state,
;;       it is overwritten - but only if compilation succeeds.
;;       The grammar parser depends on the file name suffix:
;;         .gf    normal GF source
;;         .gfc   canonical GF
;;         .gfr   precompiled GF resource
;;         .gfcm  multilingual canonical GF
;;         .gfe   example-based grammar files (only with the -ex option)
;;         .ebnf  Extended BNF format
;;         .cf    Context-free (BNF) format
;;   options:
;;       -old          old: parse in GF<2.0 format (not necessary)
;;       -v            verbose: give lots of messages
;;       -s            silent: don't give error messages
;;       -src          source: ignore precompiled gfc and gfr files
;;       -retain       retain operations: read resource modules (needed in comm cc)
;;       -nocf         don't build context-free grammar (thus no parser)
;;       -nocheckcirc  don't eliminate circular rules from CF
;;       -cflexer      build an optimized parser with separate lexer trie
;;       -noemit       do not emit code (default with old grammar format)
;;       -o            do emit code (default with new grammar format)
;;       -ex           preprocess .gfe files if needed
;;   flags:
;;       -abs          set the name used for abstract syntax (with -old option)
;;       -cnc          set the name used for concrete syntax (with -old option)
;;       -res          set the name used for resource (with -old option)
;;       -path         use the (colon-separated) search path to find modules
;;       -optimize     select an optimization to override file-defined flags
;;       -conversion   select parsing method (values strict|nondet)
;;   examples:
;;       i English.gf                      -- ordinary import of Concrete
;;       i -retain german/ParadigmsGer.gf  -- import of Resource to test

(defun pcomplete/inf-gf-mode/i ()
  (gf-complete-options
   '("old" "v" "s" "src" "retain" "nocf" "nocheckcirc"
     "cflexer" "noemit" "o" "ex")
   '("abs" "cnc" "res" "path" "optimize" "conversion")
   '(("conversion" . ("strict" "nondet")))
   (lambda ()
     (pcomplete-dirs-or-entries
      (regexp-opt
       '(".gf" ".gfc" ".gfr" ".gfcm" ".gfe" ".ebnf" ".cf"
	 ".trc"))))))

;; * rl, remove_language: rl Language
;;       Takes away the language from the state.
(defun pcomplete/inf-gf-mode/rl ()
  (pcomplete-here (gf-complete-lang)))

;; e,  empty: e
;;       Takes away all languages and resets all global flags.
(defun pcomplete/inf-gf-mode/e ())

;; sf, set_flags: sf Flag*
;;       The values of the Flags are set for Language. If no language
;;       is specified, the flags are set globally.
;;   examples:
;;       sf -nocpu     -- stop showing CPU time
;;       sf -lang=Swe  -- make Swe the default concrete
(defun pcomplete/inf-gf-mode/sf ()
  (message "Usage: sf Flag*")
  (throw 'pcompleted nil))

;; s,  strip: s
;;       Prune the state by removing source and resource modules.
(defun pcomplete/inf-gf-mode/s ())

;; pg, print_grammar: pg
;;       Prints the actual grammar (overridden by the -lang=X flag).
;;       The -printer=X flag sets the format in which the grammar is
;;       written.
;;       N.B. since grammars are compiled when imported, this command
;;       generally does not show the grammar in the same format as the
;;       source. In particular, the -printer=latex is not supported.
;;       Use the command tg -printer=latex File to print the source
;;       grammar in LaTeX.
;;   options:
;;       -utf8  apply UTF8-encoding to the grammar
;;   flags:
;;       -printer
;;       -lang
;;   examples:
;;       pg -printer=cf  -- show the context-free skeleton
(defun pcomplete/inf-gf-mode/pg ()
  (gf-complete-options  '("utf8")
  			'("printer" "lang")))
  ;; (while (progn
  ;; 	   (cond
  ;; 	    ((pcomplete-match "\\`-printer=\\(.*\\)" 0)
  ;; 	     (pcomplete-here gf-flag-printer-options
  ;; 			     (pcomplete-match-string 1 0)))
  ;; 	    ((pcomplete-match "\\`-\\w+=" 0)
  ;; 	     (pcomplete-here))
  ;; 	    (t (pcomplete-here
  ;; 		(append  '("-utf8")
  ;; 			'("-printer=" "-lang=")))))
  ;; 	   (pcomplete-match "\\`-" 1)))

;; pm, print_multigrammar: pm
;;       Prints the current multilingual grammar in .gfcm form.
;;       (Automatically executes the strip command (s) before doing this.)
;;   options:
;;       -utf8  apply UTF8 encoding to the tokens in the grammar
;;       -utf8id apply UTF8 encoding to the identifiers in the grammar
;;       -graph print module dependency graph in 'dot' format
;;   examples:
;;       pm | wf Letter.gfcm  -- print the grammar into the file Letter.gfcm
;;       pm -printer=graph | wf D.dot  -- then do 'dot -Tps D.dot > D.ps'
(defun pcomplete/inf-gf-mode/pm ()
  (gf-complete-options '("utf8" "utf8id" "graph")
		       '("printer" "lang")
		       '(("printer" . ("graph")))))

;; vg, visualize_graph: vg
;;      Show the dependency graph of multilingual grammar via dot and gv.
(defun pcomplete/inf-gf-mode/vg ())

;; po, print_options: po
;;       Print what modules there are in the state. Also prints those
;;       flag values in the current state that differ from defaults.
(defun pcomplete/inf-gf-mode/po ())

;; pl, print_languages: pl
;;       Prints the names of currently available languages.
(defun pcomplete/inf-gf-mode/pl ())

;; pi, print_info: pi Ident
;;       Prints information on the identifier.
(defun pcomplete/inf-gf-mode/pi ()
  (message "Usage: pi Ident")
  (throw 'pcompleted nil))

;; eh, execute_history: eh File
;;       Executes commands in the file.
(defun pcomplete/inf-gf-mode/eh ()
  (pcomplete-here (pcomplete-entries)))

;; ph, print_history; ph
;;       Prints the commands issued during the GF session.
;;       The result is readable by the eh command.
;;   examples:
;;       ph | wf foo.hist"  -- save the history into a file
(defun pcomplete/inf-gf-mode/ph ())

;; -- linearization, parsing, translation, and computation

;; l,  linearize: l PattList? Tree
;;       Shows all linearization forms of Tree by the actual grammar
;;       (which is overridden by the -lang flag).
;;       The pattern list has the form [P, ... ,Q] where P,...,Q follow GF
;;       syntax for patterns. All those forms are generated that match with the
;;       pattern list. Too short lists are filled with variables in the end.
;;       Only the -table flag is available if a pattern list is specified.
;;       HINT: see GF language specification for the syntax of Pattern and Term.
;;       You can also copy and past parsing results.
;;   options:
;;       -table   show parameters
;;       -struct  bracketed form
;;       -record  record, i.e. explicit GF concrete syntax term
;;       -all     show all forms and variants
;;       -multi   linearize to all languages (the other options don't work)
;;   flags:
;;       -lang    linearize in this grammar
;;       -number  give this number of forms at most
;;       -unlexer filter output through unlexer
;;   examples:
;;       l -lang=Swe -table  -- show full inflection table in Swe
(defun pcomplete/inf-gf-mode/l ()
  (gf-complete-options '("table" "struct" "record" "all" "multi")
		       '("lang" "number" "unlexer"))
  (message "Usage: l [-option*] PattList? Tree")
  (throw 'pcompleted nil))

;; p,  parse: p String
;;       Shows all Trees returned for String by the actual
;;       grammar (overridden by the -lang flag), in the category S (overridden
;;       by the -cat flag).
;;   options for batch input:
;;       -lines   parse each line of input separately, ignoring empty lines
;;       -all     as -lines, but also parse empty lines
;;   options for selecting parsing method:
;;       (default)parse using an overgenerating CFG
;;       -cfg     parse using a much less overgenerating CFG
;;       -mcfg    parse using an even less overgenerating MCFG
;;       Note:    the first time parsing with -cfg or -mcfg might take a long time
;;   options that only work for the default parsing method:
;;       -n       non-strict: tolerates morphological errors
;;       -ign     ignore unknown words when parsing
;;       -raw     return context-free terms in raw form
;;       -v       verbose: give more information if parsing fails
;;   flags:
;;       -cat     parse in this category
;;       -lang    parse in this grammar
;;       -lexer   filter input through this lexer
;;       -parser  use this parsing strategy
;;       -number  return this many results at most
;;   examples:
;;       p -cat=S -mcfg "jag är gammal"   -- parse an S with the MCFG
;;       rf examples.txt | p -lines      -- parse each non-empty line of the file
(defun pcomplete/inf-gf-mode/p ()
  (gf-complete-options
   '("lines" "all" "cfg" "mcfg" "n" "ign" "raw" "v")
   '("cat" "lang" "lexer" "parser" "number"))
  (message "Usage: p [-option*] String")
  (throw 'pcompleted nil))

;; tt, test_tokenizer: tt String
;;       Show the token list sent to the parser when String is parsed.
;;       HINT: can be useful when debugging the parser.
;;   flags:
;;      -lexer    use this lexer
;;   examples:
;;      tt -lexer=codelit "2*(x + 3)"  -- a favourite lexer for program code
(defun pcomplete/inf-gf-mode/tt ()
  (gf-complete-options '() '("lexer"))
  (message "Usage: tt [-lexer] String")
  (throw 'pcompleted nil))

;; cc, compute_concrete: cc Term
;;       Compute a term by concrete syntax definitions. Uses the topmost
;;       resource module (the last in listing by command po) to resolve
;;       constant names.
;;       N.B. You need the flag -retain when importing the grammar, if you want
;;       the oper definitions to be retained after compilation; otherwise this
;;       command does not expand oper constants.
;;       N.B.' The resulting Term is not a term in the sense of abstract syntax,
;;       and hence not a valid input to a Tree-demanding command.
;;   flags:
;;      -res      use another module than the topmost one
;;   examples:
;;      cc -res=ParadigmsFin (nLukko "hyppy")   -- inflect "hyppy" with nLukko
(defun pcomplete/inf-gf-mode/cc ()
  (gf-complete-options '() '("res"))
  (message "Usage: cc [-res] Term")
  (throw 'pcompleted nil))

;; so, show_operations: so Type
;;       Show oper operations with the given value type. Uses the topmost
;;       resource module to resolve constant names.
;;       N.B. You need the flag -retain when importing the grammar, if you want
;;       the oper definitions to be retained after compilation; otherwise this
;;       command does not find any oper constants.
;;       N.B.' The value type may not be defined in a supermodule of the
;;       topmost resource. In that case, use appropriate qualified name.
;;   flags:
;;      -res      use another module than the topmost one
;;   examples:
;;      so -res=ParadigmsFin ResourceFin.N  -- show N-paradigms in ParadigmsFin
(defun pcomplete/inf-gf-mode/so ()
  (gf-complete-options '() '("res"))
  (message "Usage: so [-res] Type")
  (throw 'pcompleted nil))

;; t,  translate: t Lang Lang String
;;       Parses String in Lang1 and linearizes the resulting Trees in Lang2.
;;   flags:
;;       -cat
;;       -lexer
;;       -parser
;;   examples:
;;       t Eng Swe -cat=S "every number is even or odd"
(defun pcomplete/inf-gf-mode/t ()
  (gf-complete-options '() '("cat" "lexer" "parser"))
  (message "Usage: t [-options] Lang Lang String")
  (throw 'pcompleted nil))

;; gr, generate_random: gr Tree?
;;       Generates a random Tree of a given category. If a Tree
;;       argument is given, the command completes the Tree with values to
;;       the metavariables in the tree.
;;   flags:
;;       -cat     generate in this category
;;       -lang    use the abstract syntax of this grammar
;;       -number  generate this number of trees (not impl. with Tree argument)
;;       -depth   use this number of search steps at most
;;   examples:
;;       gr -cat=Query            -- generate in category Query
;;       gr (PredVP ? (NegVG ?))  -- generate a random tree of this form
;;       gr -cat=S -tr | l        -- gererate and linearize
(defun pcomplete/inf-gf-mode/gr ()
  (ding)
  (gf-complete-options '() '("cat" "lang" "number" "depth"))
  (message "Usage: gr [-options] Tree?")
  (throw 'pcompleted nil))

;; gt, generate_trees: gt Tree?
;;       Generates all trees up to a given depth. If the depth is large,
;;       a small -alts is recommended. If a Tree argument is given, the
;;       command completes the Tree with values to the metavariables in
;;       the tree.
;;   options:
;;       -metas   also return trees that include metavariables
;;   flags:
;;       -depth   generate to this depth (default 3)
;;       -alts    take this number of alternatives at each branch (default unlimited)
;;       -cat     generate in this category
;;       -lang    use the abstract syntax of this grammar
;;       -number  generate (at most) this number of trees
;;   examples:
;;       gt -depth=10 -cat=NP     -- generate all NP's to depth 10
;;       gt (PredVP ? (NegVG ?))  -- generate all trees of this form
;;       gt -cat=S -tr | l        -- gererate and linearize
(defun pcomplete/inf-gf-mode/gt ()
  (gf-complete-options '("metas")
		       '("depth" "alts" "cat" "lang" "number")))

;; ma, morphologically_analyse: ma String
;;       Runs morphological analysis on each word in String and displays
;;       the results line by line.
;;   options:
;;       -short   show analyses in bracketed words, instead of separate lines
;;   flags:
;;       -lang
;;   examples:
;;       wf Bible.txt | ma -short | wf Bible.tagged  -- analyse the Bible
(defun pcomplete/inf-gf-mode/ma ()
  (gf-complete-options '("short") '("lang")))

;; -- elementary generation of Strings and Trees

;; ps, put_string: ps String
;;       Returns its argument String, like Unix echo.
;;       HINT. The strength of ps comes from the possibility to receive the
;;       argument from a pipeline, and altering it by the -filter flag.
;;   flags:
;;       -filter  filter the result through this string processor
;;       -length  cut the string after this number of characters
;;   examples:
;;       gr -cat=Letter | l | ps -filter=text -- random letter as text
(defun pcomplete/inf-gf-mode/ps ()
  (gf-complete-options '() '("filter" "length")))

;; pt, put_tree: pt Tree
;;       Returns its argument Tree, like a specialized Unix echo.
;;       HINT. The strength of pt comes from the possibility to receive
;;       the argument from a pipeline, and altering it by the -transform flag.
;;   flags:
;;       -transform   transform the result by this term processor
;;       -number      generate this number of terms at most
;;   examples:
;;       p "zero is even" | pt -transform=solve  -- solve ?'s in parse result
(defun pcomplete/inf-gf-mode/pt ()
  (gf-complete-options '() '("transform" "number")))

;; * st, show_tree: st Tree
;;       Prints the tree as a string. Unlike pt, this command cannot be
;;       used in a pipe to produce a tree, since its output is a string.
;;   flags:
;;       -printer     show the tree in a special format (-printer=xml supported)
(defun pcomplete/inf-gf-mode/st ())

;; wt, wrap_tree: wt Fun
;;       Wraps the tree as the sole argument of Fun.
;;   flags:
;;       -c           compute the resulting new tree to normal form
(defun pcomplete/inf-gf-mode/wt ()
  (gf-complete-options '("c") '()))

;; vt, visualize_tree: vt Tree
;;       Shows the abstract syntax tree via dot and gv (via temporary files
;;       grphtmp.dot, grphtmp.ps).
;;   flags:
;;       -c           show categories only (no functions)
;;       -f           show functions only (no categories)
;;       -g           show as graph (sharing uses of the same function)
;;       -o           just generate the .dot file
;;   examples:
;;     p "hello world" | vt -o | wf my.dot ;; ! open -a GraphViz my.dot
;;     -- This writes the parse tree into my.dot and opens the .dot file
;;     -- with another application without generating .ps.
(defun pcomplete/inf-gf-mode/vt ()
  (gf-complete-options '("c" "f" "g" "o") '()))

;; -- subshells

;; es, editing_session: es
;;       Opens an interactive editing session.
;;       N.B. Exit from a Fudget session is to the Unix shell, not to GF.
;;   options:
;;       -f Fudget GUI (necessary for Unicode; only available in X Window System)

;; ts, translation_session: ts
;;       Translates input lines from any of the actual languages to all other ones.
;;       To exit, type a full stop (.) alone on a line.
;;       N.B. Exit from a Fudget session is to the Unix shell, not to GF.
;;       HINT: Set -parser and -lexer locally in each grammar.
;;   options:
;;       -f    Fudget GUI (necessary for Unicode; only available in X Windows)
;;       -lang prepend translation results with language names
;;   flags:
;;       -cat    the parser category
;;   examples:
;;       ts -cat=Numeral -lang  -- translate numerals, show language names
(defun pcomplete/inf-gf-mode/ts ()
  (gf-complete-options '("f" "lang") '("cat")))

;; tq, translation_quiz: tq Lang Lang
;;       Random-generates translation exercises from Lang1 to Lang2,
;;       keeping score of success.
;;       To interrupt, type a full stop (.) alone on a line.
;;       HINT: Set -parser and -lexer locally in each grammar.
;;   flags:
;;       -cat
;;   examples:
;;       tq -cat=NP TestResourceEng TestResourceSwe  -- quiz for NPs
(defun pcomplete/inf-gf-mode/tq ()
  (pcomplete-here (gf-complete-lang))
  (pcomplete-here (gf-complete-lang)))

;; tl, translation_list: tl Lang Lang
;;       Random-generates a list of ten translation exercises from Lang1
;;       to Lang2. The number can be changed by a flag.
;;       HINT: use wf to save the exercises in a file.
;;   flags:
;;       -cat
;;       -number
;;   examples:
;;       tl -cat=NP TestResourceEng TestResourceSwe  -- quiz list for NPs
(defun pcomplete/inf-gf-mode/tl ()
  (pcomplete-here (gf-complete-lang))
  (pcomplete-here (gf-complete-lang)))

;; mq, morphology_quiz: mq
;;       Random-generates morphological exercises,
;;       keeping score of success.
;;       To interrupt, type a full stop (.) alone on a line.
;;       HINT: use printname judgements in your grammar to
;;       produce nice expressions for desired forms.
;;   flags:
;;       -cat
;;       -lang
;;   examples:
;;       mq -cat=N -lang=TestResourceSwe  -- quiz for Swedish nouns

;; ml, morphology_list: ml
;;       Random-generates a list of ten morphological exercises,
;;       keeping score of success. The number can be changed with a flag.
;;       HINT: use wf to save the exercises in a file.
;;   flags:
;;       -cat
;;       -lang
;;       -number
;;   examples:
;;       ml -cat=N -lang=TestResourceSwe  -- quiz list for Swedish nouns
(defun pcomplete/inf-gf-mode/ml ()
  (gf-complete-options '() '("cat" "lang" "number")))

;; -- IO related commands

;; rf, read_file: rf File
;;       Returns the contents of File as a String; error if File does not exist.
(defun pcomplete/inf-gf-mode/rf ()
  (pcomplete-here (pcomplete-entries)))

;; wf, write_file: wf File String
;;       Writes String into File; File is created if it does not exist.
;;       N.B. the command overwrites File without a warning.

;; af, append_file: af File
;;       Writes String into the end of File; File is created if it does not exist.

;; * tg, transform_grammar: tg File
;;       Reads File, parses as a grammar,
;;       but instead of compiling further, prints it.
;;       The environment is not changed. When parsing the grammar, the same file
;;       name suffixes are supported as in the i command.
;;       HINT: use this command to print the grammar in
;;       another format (the -printer flag); pipe it to wf to save this format.
;;   flags:
;;       -printer  (only -printer=latex supported currently)

;; * cl, convert_latex: cl File
;;       Reads File, which is expected to be in LaTeX form.
;;       Three environments are treated in special ways:
;;         \begGF    - \end{verbatim}, which contains GF judgements,
;;         \begTGF   - \end{verbatim}, which contains a GF expression (displayed)
;;         \begInTGF - \end{verbatim}, which contains a GF expressions (inlined).
;;       Moreover, certain macros should be included in the file; you can
;;       get those macros by applying 'tg -printer=latex foo.gf' to any grammar
;;       foo.gf. Notice that the same File can be imported as a GF grammar,
;;       consisting of all the judgements in \begGF environments.
;;       HINT: pipe with 'wf Foo.tex' to generate a new Latex file.

;; sa, speak_aloud: sa String
;;       Uses the Flite speech generator to produce speech for String.
;;       Works for American English spelling.
;;   examples:
;;     h | sa              -- listen to the list of commands
;;     gr -cat=S | l | sa  -- generate a random sentence and speak it aloud

;; h, help: h Command?
;;       Displays the paragraph concerning the command from this help file.
;;       Without the argument, shows the first lines of all paragraphs.
;;   options
;;        -all  show the whole help file
;;   examples:
;;        h print_grammar  -- show all information on the pg command

;; q, quit: q
;;       Exits GF.
;;       HINT: you can use 'ph | wf history' to save your session.

;; !, system_command: ! String
;;       Issues a system command. No value is returned to GF.
;;    example:
;;       ! ls
(defun pcomplete/inf-gf-mode/! ()
  ;;(pcomplete-here (eshell-complete-commands-list))
  )

;; -- Flags. The availability of flags is defined separately for each command.

;; -cat, category in which parsing is performed.
;;       The default is S.

;; -depth, the search depth in e.g. random generation.
;;       The default depends on application.

;; -filter, operation performed on a string. The default is identity.
;;     -filter=identity     no change
;;     -filter=erase        erase the text
;;     -filter=take100      show the first 100 characters
;;     -filter=length       show the length of the string
;;     -filter=text         format as text (punctuation, capitalization)
;;     -filter=code         format as code (spacing, indentation)
(defvar gf-flag-filter-options
  '("identity" "erase" "take100" "length" "text" "code"))

;; -lang, grammar used when executing a grammar-dependent command.
;;        The default is the last-imported grammar.

(defvar gf-lang-cache 'empty)
(defun gf-clear-lang-cache () (setq gf-lang-cache 'empty))

(defvar gf-flag-lang-options 'gf-complete-lang)
(defun gf-complete-lang ()
  (if (listp gf-lang-cache)
      gf-lang-cache
    (setq gf-lang-cache
	  (gf-collect-results
	   gf-process "pl"
	   (lambda ()
	     ;; we're at point-min
	     (let (result)
	       (while (re-search-forward "\\S-+" (point-at-eol) t)
		 (push (match-string 0) result))
	       result))))))

;; -language, voice used by Festival as its --language flag in the sa command.
;;        The default is system-dependent.

;; -length, the maximum number of characters shown of a string.
;;        The default is unlimited.

;; -lexer, tokenization transforming a string into lexical units for a parser.
;;        The default is words.
;;     -lexer=words         tokens are separated by spaces or newlines
;;     -lexer=literals      like words, but GF integer and string literals recognized
;;     -lexer=vars          like words, but "x","x_...","$...$" as vars, "?..." as meta
;;     -lexer=chars         each character is a token
;;     -lexer=code          use Haskell's lex
;;     -lexer=codevars      like code, but treat unknown words as variables, ?? as meta
;;     -lexer=text          with conventions on punctuation and capital letters
;;     -lexer=codelit       like code, but treat unknown words as string literals
;;     -lexer=textlit       like text, but treat unknown words as string literals
;;     -lexer=codeC         use a C-like lexer
(defvar gf-flag-lexer-options
  '("words" "literals" "vars" "chars" "code" "codevars"
    "text" "codelit" "textlit" "codeC"))

;; -number, the maximum number of generated items in a list.
;;        The default is unlimited.

;; -optimize, optimization on generated code.
;;        The default is share for concrete, none for resource modules.
;;        Each of the flags can have the suffix _subs, which performs
;;        common subexpression elimination after the main optimization.
;;        Thus, -optimize=all_subs is the most aggressive one.

;;     -optimize=share        share common branches in tables
;;     -optimize=parametrize  first try parametrize then do share with the rest
;;     -optimize=values       represent tables as courses-of-values
;;     -optimize=all          first try parametrize then do values with the rest
;;     -optimize=none         no optimization
(defvar gf-flag-optimize-options
  '("share" "parametrize" "values" "all" "none"))

;; -parser, parsing strategy. The default is chart. If -cfg or -mcfg are selected, only bottomup and topdown are recognized.
;;     -parser=chart          bottom-up chart parsing
;;     -parser=bottomup       a more up to date bottom-up strategy
;;     -parser=topdown        top-down strategy
;;     -parser=old            an old bottom-up chart parser
(defvar gf-flag-parser-options
  '("chart" "bottomup" "topdown" "old"))

;; -printer, format in which the grammar is printed. The default is gfc.
;;     -printer=gfc            GFC grammar
;;     -printer=gf             GF grammar
;;     -printer=old            old GF grammar
;;     -printer=cf             context-free grammar, with profiles
;;     -printer=bnf            context-free grammar, without profiles
;;     -printer=lbnf           labelled context-free grammar for BNF Converter
;;     -printer=plbnf          grammar for BNF Converter, with precedence levels
;;    *-printer=happy          source file for Happy parser generator (use lbnf!);;     -printer=srg            speech recognition grammar
;;     -printer=haskell        abstract syntax in Haskell, with transl to/from GF
;;     -printer=morpho         full-form lexicon, long format
;;    *-printer=latex          LaTeX file (for the tg command)
;;     -printer=fullform       full-form lexicon, short format
;;    *-printer=xml            XML: DTD for the pg command, object for st
;;     -printer=old            old GF: file readable by GF 1.2
;;     -printer=stat           show some statistics of generated GFC
;;     -printer=gsl            Nuance GSL speech recognition grammar
;;     -printer=jsgf           Java Speech Grammar Format
;;     -printer=slf            a finite automaton in the HTK SLF format
;;     -printer=slf_graphviz   the same automaton as in SLF, but in Graphviz format
;;     -printer=fa_graphviz    a finite automaton with labelled edges
;;     -printer=regular        a regular grammar in a simple BNF
;;     -printer=unpar          a gfc grammar with parameters eliminated
(defvar gf-flag-printer-options
  '("gfc" "gf" "cf" "old" "srg" "gsl" "jsgf" "slf" "slf_graphviz"
    "fa_graphviz" "regular" "plbnf" "lbnf" "bnf" "haskell" "morpho"
    "fullform" "opts" "words" "printnames" "stat" "unpar" "subs"
    "mcfg" "cfg" "pinfo" "abstract" "gfc-haskell" "mcfg-haskell"
    "cfg-haskell" "gfc-prolog" "mcfg-prolog" "cfg-prolog" "abs-skvatt"
    "cfg-skvatt" "simple" "mcfg-erasing" "mcfg-old" "cfg-old"
    ;;"happy" "latex" "xml"
    ))


;; -startcat, like -cat, but used in grammars (to avoid clash with keyword cat)

;; -transform, transformation performed on a syntax tree. The default is identity.
;;     -transform=identity  no change
;;     -transform=compute   compute by using definitions in the grammar
;;     -transform=typecheck return the term only if it is type-correct
;;     -transform=solve     solve metavariables as derived refinements
;;     -transform=context   solve metavariables by unique refinements as variables
;;     -transform=delete    replace the term by metavariable
(defvar gf-flag-transform-options
  '("identity" "compute" "typecheck" "solve" "context" "delete"))

;; -unlexer, untokenization transforming linearization output into a string.
;;        The default is unwords.
;;     -unlexer=unwords     space-separated token list (like unwords)
;;     -unlexer=text        format as text: punctuation, capitals, paragraph <p>
;;     -unlexer=code        format as code (spacing, indentation)
;;     -unlexer=textlit     like text, but remove string literal quotes
;;     -unlexer=codelit     like code, but remove string literal quotes
;;     -unlexer=concat      remove all spaces
;;     -unlexer=bind        like identity, but bind at "&+"
(defvar gf-flag-unlexer-options
  '("unwords" "text" "code" "textlit" "codelit" "concat" "bind"))

;; -- *: Commands and options marked with * are not yet implemented.

(defvar gf-flags-table
  `(("filter"    . ,gf-flag-filter-options)
    ("lang"      . ,gf-flag-lang-options)
    ("lexer"	 . ,gf-flag-lexer-options)
    ("optimize"  . ,gf-flag-optimize-options)
    ("parser"    . ,gf-flag-parser-options)
    ("printer"   . ,gf-flag-printer-options)
    ("transform" . ,gf-flag-transform-options)
    ("unlexer"   . ,gf-flag-unlexer-options)))

;;; gf.el ends here