![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to sml-mode.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / sml / lib / emacs|
Return to sml-mode.el CVS log | Up to [Research Unix] / researchv10no / cmd / sml / lib / emacs |
1.1 root 1: ;; sml-mode.el. Major mode for editing (Standard) ML.
2: ;; Copyright (C) 1989, Free Software Foundation, Inc.
3:
4: ;; This file is part of GNU Emacs.
5:
6: ;; GNU Emacs is distributed in the hope that it will be useful,
7: ;; but WITHOUT ANY WARRANTY. No author or distributor
8: ;; accepts responsibility to anyone for the consequences of using it
9: ;; or for whether it serves any particular purpose or works at all,
10: ;; unless he says so in writing. Refer to the GNU Emacs General Public
11: ;; License for full details.
12:
13: ;; Everyone is granted permission to copy, modify and redistribute
14: ;; GNU Emacs, but only under the conditions described in the
15: ;; GNU Emacs General Public License. A copy of this license is
16: ;; supposed to have been given to you along with GNU Emacs so you
17: ;; can know your rights and responsibilities. It should be in a
18: ;; file named COPYING. Among other things, the copyright notice
19: ;; and this notice must be preserved on all copies.
20:
21: ;; AUTHOR Lars Bo Nielsen
22: ;; Aalborg University
23: ;; Computer Science Dept.
24: ;; 9000 Aalborg
25: ;; Denmark
26: ;;
27: ;; EMAIL [email protected]
28: ;; or: ...!mcvax!diku!iesd!lbn
29: ;; or: [email protected]
30: ;;
31: ;; Please let me know if you come up with any ideas, bugs, or fixes.
32: ;;
33:
34:
35: (provide 'sml-mode)
36:
37: (defconst sml-mode-version-string
38: "SML-MODE, Version 2.4 (Oct 1989) ([email protected])")
39:
40: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
41: ;;;
42: ;;; CONSTANTS CONTROLLING THE MODE.
43: ;;;
44: ;;; These are the constants you might want to change
45: ;;;
46:
47: ;; The amount of indentation of blocks
48: (defconst sml-indent-level 4 "*Indentation of blocks in sml.")
49:
50: ;; The amount of negative indentation of lines beginning with "|"
51: (defconst sml-pipe-indent -2
52: "*Extra (negative) indentation for lines beginning with |.") ;
53:
54: ;; How do we indent case-of expressions.
55: (defconst sml-case-indent nil
56: "*How to indent case-of expressions.
57: If t: case expr If nil: case expr of
58: of exp1 => ... exp1 => ...
59: | exp2 => ... | exp2 => ...
60: \nThe first seems to be the standard in NJ-SML. The second is the default.")
61:
62: (defconst sml-nested-if-indent nil
63: "*If set to t, nested if-then-else expression will have the same
64: indentation as:
65: if exp1 then exp2
66: else if exp3 then exp4
67: else if exp5 then exp6
68: else exp7")
69:
70: (defconst sml-type-of-indent t
71: "*How to indent `let' `struct' etc.
72:
73: If t: fun foo bar = let If nil: fun foo bar = let
74: val p = 4 val p = 4
75: in in
76: bar + p bar + p
77: end end
78:
79: Will not have any effect if the starting keyword is first on the line.")
80:
81: (defconst sml-electric-semi-mode t
82: "*If t, a `\;' will insert itself, reindent the line, and perform a newline.
83: If nil, just insert a `\;'. (To insert while t, do: C-q \;).")
84:
85: ;; How far should the indentation algorithm look to find open parenthesis
86: (defconst sml-paren-lookback 200
87: "*Determines how far back (in chars) the indentation algorithm
88: should look for open parenthesis. High value means slow indentation
89: algorithm. A value of 200 (being the equivalent of 4-6 lines) should
90: suffice most uses. (A value of nil, means do not look at all)")
91:
92: ;; The command used to start up the sml-program.
93: (defconst sml-prog-name "sml" "*Name of program to run as sml.")
94:
95: ;; If t, you will be asked which program to run when the inferior
96: ;; shell starts up. Usefull if you have exported images of sml.
97: (defconst sml-prog-name-ask-p nil
98: "*Should you be asked for the name of the program to run.")
99:
100: ;; The left delimmitter for `use file'
101: (defconst sml-use-left-delim "\""
102: "*The left delimiter for the filename when using \"use\".
103: To be set to `[\\\"' for Edinburgh SML, and `\\\"' for New Jersey SML.
104: Correspondes to `sml-use-right-delim'.")
105:
106: ;; The right delimmitter for `use file'
107: (defconst sml-use-right-delim "\""
108: "*The right delimiter for the filename when using \"use\".
109: To be set to `\\\"]' for Edinburgh SML, and `\\\"' for New Jersey SML.
110: Correspondes to `sml-use-left-delim'.")
111:
112: ;; A regular expression matching the prompt pattern in the inferior
113: ;; shell
114: (defconst sml-shell-prompt-pattern "^[^\-=]*[\-=] *"
115: "*The prompt pattern for the inferion shell running sml.")
116:
117: ;; The template used for temporary files, created when a region is
118: ;; send to the inferior process running sml.
119: (defconst sml-tmp-template "/tmp/sml.tmp."
120: "*Template for the temporary file, created by sml-simulate-send-region.")
121:
122: ;; The name of the process running sml (This will also be the name of
123: ;; the buffer).
124: (defconst sml-process-name "SML" "*The name of the SML-process")
125:
126: ;;;
127: ;;; END OF CONSTANTS CONTROLLING THE MODE.
128: ;;;
129: ;;; If you change anything below, you are on your own.
130: ;;;
131: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
132:
133:
134: (defvar sml-mode-map nil "The mode map used in sml-mode.")
135: (if sml-mode-map
136: ()
137: (setq sml-mode-map (make-sparse-keymap))
138: (define-key sml-mode-map "\C-c'" 'sml-next-error)
139: (define-key sml-mode-map "\C-c\C-v" 'sml-mode-version)
140: (define-key sml-mode-map "\C-c\C-u" 'sml-save-buffer-use-file)
141: (define-key sml-mode-map "\C-c\C-s" 'sml-pop-to-shell)
142: (define-key sml-mode-map "\C-c\C-r" 'sml-send-region)
143: (define-key sml-mode-map "\C-c\C-m" 'sml-region)
144: (define-key sml-mode-map "\C-c\C-k" 'sml-skip-errors)
145: (define-key sml-mode-map "\C-c\C-f" 'sml-run-on-file)
146: (define-key sml-mode-map "\C-c\C-c" 'sml-send-function)
147: (define-key sml-mode-map "\C-c\C-b" 'sml-send-buffer)
148: (define-key sml-mode-map "\C-ci" 'sml-import-file)
149: (define-key sml-mode-map "\e|" 'sml-electric-pipe)
150: (define-key sml-mode-map "\C-j" 'reindent-then-newline-and-indent)
151: (define-key sml-mode-map "\177" 'backward-delete-char-untabify)
152: (define-key sml-mode-map "\;" 'sml-electric-semi)
153: (define-key sml-mode-map "\C-c\t" 'sml-indent-region)
154: (define-key sml-mode-map "\t" 'sml-indent-line))
155:
156: (defvar sml-mode-syntax-table nil "The syntax table used in sml-mode.")
157: (if sml-mode-syntax-table
158: ()
159: (setq sml-mode-syntax-table (make-syntax-table))
160: (modify-syntax-entry ?\( "()1" sml-mode-syntax-table)
161: (modify-syntax-entry ?\) ")(4" sml-mode-syntax-table)
162: (modify-syntax-entry ?\\ "\\" sml-mode-syntax-table)
163: (modify-syntax-entry ?* ". 23" sml-mode-syntax-table)
164: ;; Special characters in sml-mode to be treated as normal
165: ;; characters:
166: (modify-syntax-entry ?_ "w" sml-mode-syntax-table)
167: (modify-syntax-entry ?\' "w" sml-mode-syntax-table))
168:
169:
170: (defun sml-mode ()
171: "Major mode for editing SML code.
172: Tab indents for SML code.
173: Comments are delimited with (* ... *).
174: Paragraphs are separated by blank lines only.
175: Delete converts tabs to spaces as it moves back.
176:
177: Key bindings:
178: =============
179:
180: \\[sml-indent-line]\t - Indent current line.
181: \\[reindent-then-newline-and-indent]\t - Reindent line, newline and indent.
182: \\[sml-indent-region]\t - Indent region.
183: \\[sml-electric-pipe]\t - Insert a \"|\". Insert function name, \"=>\" etc.
184: \\[sml-region]\t - Insert a common used structure.
185: \\[sml-pop-to-shell]\t - Pop to the sml window.
186: \\[sml-next-error]\t - Find the next error.
187: \\[sml-save-buffer-use-file]\t - Save the buffer, and send a \"use file\".
188: \\[sml-send-region]\t - Send region (point and mark) to sml.
189: \\[sml-run-on-file]\t - Send a \"use file\" to sml.
190: \\[sml-import-file]\t - Send a \"import file\" to sml.
191: \\[sml-send-function]\t - Send function to sml.
192: \\[sml-send-buffer]\t - Send whole buffer to sml.
193: \\[sml-mode-version]\t - Get the version of sml-mode
194:
195:
196: Variables controlling the indentation
197: =====================================
198:
199: sml-indent-level (default 4)
200: The indentation of a block of code.
201:
202: sml-pipe-indent (default -2)
203: Extra indentation of a line starting with \"|\".
204:
205: sml-case-indent (default nil)
206: Determine the way to indent case-of expression.
207: If t: case expr If nil: case expr of
208: of exp1 => ... exp1 => ...
209: | exp2 => ... | exp2 => ...
210:
211: The first seems to be the standard in NJ-SML. The second is the default.
212:
213: sml-nested-if-indent (default nil)
214: If set to t, nested if-then-else expression will have the same
215: indentation as:
216: if exp1 then exp2
217: else if exp3 then exp4
218: else if exp5 then exp6
219: else exp7
220:
221: sml-type-of-indent (default t)
222: How to indent `let' `struct' etc.
223:
224: If t: fun foo bar = let If nil: fun foo bar = let
225: val p = 4 val p = 4
226: in in
227: bar + p bar + p
228: end end
229:
230: Will not have any effect if the starting keyword is first on the line.
231:
232: sml-electric-semi-mode (default t)
233: If t, a `\;' will reindent line, and perform a newline.
234:
235: Mode map
236: ========
237: \\{sml-mode-map}
238: Runs sml-mode-hook if non nil."
239: (interactive)
240: (kill-all-local-variables)
241: (use-local-map sml-mode-map)
242: (setq major-mode 'sml-mode)
243: (setq mode-name "Sml")
244: (define-abbrev-table 'sml-mode-abbrev-table ())
245: (setq local-abbrev-table sml-mode-abbrev-table)
246: (set-syntax-table sml-mode-syntax-table)
247: ;; A paragraph is seperated by blank lines (or ^L) only.
248: (make-local-variable 'paragraph-start)
249: (setq paragraph-start (concat "^[\t ]*$\\|" page-delimiter))
250: (make-local-variable 'paragraph-separate)
251: (setq paragraph-separate paragraph-start)
252: (make-local-variable 'indent-line-function)
253: (setq indent-line-function 'sml-indent-line)
254: (make-local-variable 'require-final-newline) ; Always put a new-line
255: (setq require-final-newline t) ; in the end of file
256: (make-local-variable 'comment-start)
257: (setq comment-start "(* ")
258: (make-local-variable 'comment-end)
259: (setq comment-end " *)")
260: (make-local-variable 'comment-column)
261: (setq comment-column 39) ; Start of comment in this column
262: (make-local-variable 'comment-start-skip)
263: (setq comment-start-skip "(\\*+[ \t]?") ; This matches a start of comment
264: (make-local-variable 'comment-indent-hook)
265: (setq comment-indent-hook 'sml-comment-indent)
266: ;;
267: ;; Adding these will fool the matching of parens. I really don't
268: ;; know why. It would be nice to have comments treated as
269: ;; white-space
270: ;;
271: ;; (make-local-variable 'parse-sexp-ignore-comments)
272: ;; (setq parse-sexp-ignore-comments t)
273: ;;
274: (run-hooks 'sml-mode-hook)) ; Run the hook
275:
276: (defconst sml-pipe-matchers-reg
277: "\\bcase\\b\\|\\bfn\\b\\|\\bfun\\b\\|\\bhandle\\b\
278: \\|\\bdatatype\\b\\|\\babstype\\b\\|\\band\\b"
279: "The keywords a `|' can follow.")
280:
281: (defun sml-electric-pipe ()
282: "Insert a \"|\". Depending on the context insert the name of
283: function, a \"=>\" etc."
284: (interactive)
285: (let ((here (point))
286: (match (save-excursion
287: (sml-find-matching-starter sml-pipe-matchers-reg)
288: (point)))
289: (tmp " => ")
290: (case-or-handle-exp t))
291: (if (/= (save-excursion (beginning-of-line) (point))
292: (save-excursion (skip-chars-backward "\t ") (point)))
293: (insert "\n"))
294: (insert "|")
295: (save-excursion
296: (goto-char match)
297: (cond
298: ;; It was a function, insert the function name
299: ((looking-at "fun\\b")
300: (setq tmp (concat " " (buffer-substring
301: (progn (forward-char 3)
302: (skip-chars-forward "\t\n ") (point))
303: (progn (forward-word 1) (point))) " "))
304: (setq case-or-handle-exp nil))
305: ;; It was a datatype, insert nothing
306: ((looking-at "datatype\\b\\|abstype\\b")
307: (setq tmp " ") (setq case-or-handle-exp nil))
308: ;; If is and, then we have to see what is was
309: ((looking-at "and\\b")
310: (let (isfun)
311: (save-excursion
312: (condition-case ()
313: (progn
314: (re-search-backward "datatype\\b\\|abstype\\b\\|fun\\b")
315: (setq isfun (looking-at "fun\\b")))
316: (error (setq isfun nil))))
317: (if isfun
318: (progn
319: (setq tmp
320: (concat " " (buffer-substring
321: (progn (forward-char 3)
322: (skip-chars-forward "\t\n ") (point))
323: (progn (forward-word 1) (point))) " "))
324: (setq case-or-handle-exp nil))
325: (setq tmp " ") (setq case-or-handle-exp nil))))))
326: (insert tmp)
327: (sml-indent-line)
328: (beginning-of-line)
329: (skip-chars-forward "\t ")
330: (forward-char (1+ (length tmp)))
331: (if case-or-handle-exp
332: (forward-char -4))))
333:
334: (defun sml-electric-semi ()
335: "If sml-electric-semi-mode is t, indent the current line, and newline."
336: (interactive)
337: (insert "\;")
338: (if sml-electric-semi-mode
339: (reindent-then-newline-and-indent)))
340:
341: (defun sml-mode-version ()
342: (interactive)
343: (message sml-mode-version-string))
344:
345:
346: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
347: ;;;
348: ;;; SHORT CUTS (sml-region)
349: ;;;
350: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
351:
352: (defconst sml-region-alist
353: '(("let") ("local") ("signature") ("structure") ("datatype")
354: ("case") ("functor") ("abstype"))
355: "The list of regions to auto-insert.")
356:
357: (defun sml-region ()
358: "Interactive short-cut. Insert a common used structure in sml."
359: (interactive)
360: (let ((newline nil) ; Did we insert a newline
361: (name (completing-read "Region to insert: (default let) "
362: sml-region-alist nil t nil)))
363: ;; default is "let"
364: (if (string= name "") (setq name "let"))
365: ;; Insert a newline if point is not at empty line
366: (sml-indent-line) ; Indent the current line
367: (if (save-excursion (beginning-of-line) (skip-chars-forward "\t ") (eolp))
368: ()
369: (setq newline t)
370: (insert "\n"))
371: (condition-case ()
372: (cond
373: ((string= name "let") (sml-let))
374: ((string= name "local") (sml-local))
375: ((string= name "structure") (sml-structure))
376: ((string= name "signature") (sml-signature))
377: ((string= name "functor") (sml-functor))
378: ((string= name "case") (sml-case))
379: ((string= name "abstype") (sml-abstype))
380: ((string= name "datatype") (sml-datatype)))
381: (quit (if newline
382: (progn
383: (delete-char -1)
384: (beep)))))))
385:
386: (defun sml-let ()
387: "Insert a `let in end'."
388: (interactive) (sml-let-local "let"))
389:
390: (defun sml-local ()
391: "Insert a `local in end'."
392: (interactive) (sml-let-local "local"))
393:
394: (defun sml-signature ()
395: "Insert a `signature ??? = sig end', prompting for name."
396: (interactive) (sml-structure-signature "signature"))
397:
398: (defun sml-structure ()
399: "Insert a `structure ??? = struct end', prompting for name."
400: (interactive) (sml-structure-signature "structure"))
401:
402: (defun sml-case ()
403: "Insert a case, prompting for case-expresion."
404: (interactive)
405: (let (indent (expr (read-string "Case expr: ")))
406: (insert (concat "case " expr))
407: (sml-indent-line)
408: (setq indent (current-indentation))
409: (end-of-line)
410: (if sml-case-indent
411: (progn
412: (insert "\n")
413: (indent-to (+ 2 indent))
414: (insert "of "))
415: (insert " of\n")
416: (indent-to (+ indent sml-indent-level)))
417: (save-excursion (insert " => "))))
418:
419: (defun sml-let-local (starter)
420: (let (indent)
421: (insert starter)
422: (sml-indent-line)
423: (setq indent (current-indentation))
424: (end-of-line)
425: (insert "\n") (indent-to (+ sml-indent-level indent))
426: (insert "\n") (indent-to indent)
427: (insert "in\n") (indent-to (+ sml-indent-level indent))
428: (insert "\n") (indent-to indent)
429: (insert "end") (previous-line 3) (end-of-line)))
430:
431: (defun sml-structure-signature (which)
432: (let (indent
433: (name (read-string (concat "Name of " which ": "))))
434: (insert (concat which " " name " ="))
435: (sml-indent-line)
436: (setq indent (current-indentation))
437: (end-of-line)
438: (insert "\n") (indent-to (+ sml-indent-level indent))
439: (insert (if (string= which "signature") "sig\n" "struct\n"))
440: (indent-to (+ (* 2 sml-indent-level) indent))
441: (insert "\n") (indent-to (+ sml-indent-level indent))
442: (insert "end") (previous-line 1) (end-of-line)))
443:
444: (defun sml-functor ()
445: "Insert a `funtor ??? () : ??? = struct end', prompting for name and type."
446: (let (indent
447: (name (read-string "Name of functor: "))
448: (signame (read-string "Signature type of functor: ")))
449: (insert (concat "functor " name " () : " signame " ="))
450: (sml-indent-line)
451: (setq indent (current-indentation))
452: (end-of-line)
453: (insert "\n") (indent-to (+ sml-indent-level indent))
454: (insert "struct\n")
455: (indent-to (+ (* 2 sml-indent-level) indent))
456: (insert "\n") (indent-to (+ sml-indent-level indent))
457: (insert "end") (previous-line 1) (end-of-line)))
458:
459: (defun sml-datatype ()
460: "Insert a `datatype ??? =', prompting for name."
461: (let (indent
462: (type (read-string (concat "Type of datatype (default none): ")))
463: (name (read-string (concat "Name of datatype: "))))
464: (insert (concat "datatype "
465: (if (string= type "") "" (concat type " "))
466: name " ="))
467: (sml-indent-line)
468: (setq indent (current-indentation))
469: (end-of-line) (insert "\n") (indent-to (+ sml-indent-level indent))))
470:
471: (defun sml-abstype ()
472: "Insert an `abstype 'a ??? = with ... end'"
473: (let (indent
474: (typevar (read-string "Name of typevariable (default 'a): "))
475: (type (read-string "Name of abstype: ")))
476: (if (string= typevar "")
477: (setq typevar "'a"))
478: (insert (concat "abstype " typevar " " type " ="))
479: (sml-indent-line)
480: (setq indent (current-indentation))
481: (insert "\n") (indent-to (+ sml-indent-level indent))
482: (insert "\n") (indent-to indent)
483: (insert "with\n") (indent-to (+ sml-indent-level indent))
484: (insert "\n") (indent-to indent)
485: (insert "end")
486: (previous-line 3)
487: (end-of-line)))
488:
489: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
490: ;;;
491: ;;; PARSING ERROR MESSAGES (NOTE: works only with SML of New Jersey)
492: ;;;
493: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
494:
495: (defvar sml-last-error 1 "Last position of error. Initially 1.")
496:
497: (defun sml-next-error ()
498: "Find the next error by passing the *SML* buffer.\n
499: NOTE: This function only knows about the syntax of errors generated by
500: SML of New Jersey, and will only work with this."
501: (interactive)
502: (let ((found t) (tmp-file nil) found-line found-file error-line tmp)
503: (save-excursion
504: (condition-case ()
505: (progn
506: (set-buffer (concat "*" sml-process-name "*" ))
507: (goto-char sml-last-error)
508: (re-search-forward "^.+line.+\\(Error:\\|Warning:\\)")
509: (save-excursion
510: (beginning-of-line)
511: (if (looking-at sml-tmp-template)
512: (setq tmp-file t)))
513: (setq sml-last-error (point))
514: (beginning-of-line)
515: (setq error-line (point))
516: (search-forward ",")
517: (setq found-file (buffer-substring error-line (1- (point))))
518: (search-forward "line ")
519: (setq tmp (point))
520: (skip-chars-forward "[0-9]")
521: (setq found-line (string-to-int (buffer-substring tmp (point)))))
522: (error (setq found nil))))
523: (if found
524: (progn
525: (set-window-start
526: (display-buffer (concat "*" sml-process-name "*")) error-line)
527: (if tmp-file
528: (let ((loop t) (n 0) (tmp-list sml-tmp-files-list))
529: (while loop
530: (setq tmp (car tmp-list))
531: (if (string= (car tmp) found-file)
532: (setq loop nil)
533: (setq tmp-list (cdr tmp-list)))
534: (if (null tmp-list) (setq loop nil)))
535: (if (null tmp)
536: (error "Temporary file not associated with buffer.")
537: (condition-case ()
538: (progn
539: (switch-to-buffer (nth 1 tmp))
540: (message
541: (concat "Error found in temporary file "
542: "(line number may not match)."))
543: (goto-line (1- (+ found-line (nth 2 tmp)))))
544: (error (error "Sorry, buffer doesn't exist any more.")))))
545: (if (file-exists-p found-file)
546: (progn
547: (condition-case ()
548: (progn
549: (find-file found-file)
550: (goto-line found-line))
551: (error ())))
552: (error (concat "File not found: " found-file)))))
553: ;; No error found
554: (if (= sml-last-error 1) ; Did we just start
555: (message "No errors yet")
556: (message "No more errors")) ; Or have we passed all errors
557: (beep))))
558:
559: (defun sml-skip-errors ()
560: "Skip past the rest of the errors."
561: (interactive)
562: (save-excursion
563: (set-buffer (concat "*" sml-process-name "*" ))
564: (setq sml-last-error (point-max))))
565:
566:
567: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
568: ;;;
569: ;;; INDENTATION
570: ;;;
571: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
572:
573: (defun sml-indent-region (begin end)
574: "Indent region of sml code."
575: (interactive "r")
576: (message "Indenting region...")
577: (save-excursion
578: (goto-char end) (setq end (point-marker)) (goto-char begin)
579: (while (< (point) end)
580: (skip-chars-forward "\t\n ")
581: (sml-indent-line)
582: (end-of-line))
583: (move-marker end nil))
584: (message "Indenting region... done"))
585:
586: (defun sml-indent-line ()
587: "Indent current line of sml code."
588: (interactive)
589: (let ((indent (sml-calculate-indentation)))
590: (if (/= (current-indentation) indent)
591: (save-excursion ;; Added 890601 (point now stays)
592: (let ((beg (progn (beginning-of-line) (point))))
593: (skip-chars-forward "\t ")
594: (delete-region beg (point))
595: (indent-to indent))))
596: ;; If point is before indentation, move point to indentation
597: (if (< (current-column) (current-indentation))
598: (skip-chars-forward "\t "))))
599:
600: (defconst sml-indent-starters-reg
601: "abstraction\\b\\|abstype\\b\\|and\\b\\|case\\b\\|datatype\\b\
602: \\|else\\b\\|fun\\b\\|functor\\b\\|if\\b\\|sharing\\b\
603: \\|in\\b\\|infix\\b\\|infixr\\b\\|let\\b\\|local\\b\
604: \\|nonfix\\b\\|of\\b\\|open\\b\\|raise\\b\\|sig\\b\\|signature\\b\
605: \\|struct\\b\\|structure\\b\\|then\\b\\|\\btype\\b\\|val\\b\
606: \\|while\\b\\|with\\b\\|withtype\\b"
607: "The indentation starters. The next line, after one starting with
608: one of these, will be indented.")
609:
610: (defconst sml-starters-reg
611: "\\babstraction\\b\\|\\babstype\\b\\|\\bdatatype\\b\
612: \\|\\bexception\\b\\|\\bfun\\b\\|\\bfunctor\\b\\|\\blocal\\b\
613: \\|\\binfix\\b\\|\\binfixr\\b\\|sharing\\b\
614: \\|\\bnonfix\\b\\|\\bopen\\b\\|\\bsignature\\b\\|\\bstructure\\b\
615: \\|\\btype\\b\\|\\bval\\b\\|\\bwithtype\\b\\|\\bwith\\b"
616: "The starters of new expressions.")
617:
618: (defconst sml-end-starters-reg
619: "\\blet\\b\\|\\blocal\\b\\|\\bsig\\b\\|\\bstruct\\b\\|\\bwith\\b"
620: "Matching reg-expression for the \"end\" keyword.")
621:
622: (defconst sml-starters-indent-after
623: "let\\b\\|local\\b\\|struct\\b\\|in\\b\\|sig\\b\\|with\\b"
624: "Indent after these.")
625:
626: (defun sml-calculate-indentation ()
627: (save-excursion
628: (beginning-of-line) ; Go to first non whitespace
629: (skip-chars-forward "\t ") ; on the line.
630: (cond
631: ;; Indentation for comments alone on a line, matches the
632: ;; proper indentation of the next line. Search only for the
633: ;; next "*)", not for the matching.
634: ((looking-at "(\\*")
635: (if (not (search-forward "*)" nil t))
636: (error "Comment not ended."))
637: (skip-chars-forward "\n\t ")
638: ;; If we are at eob, just indent 0
639: (if (eobp) 0 (sml-calculate-indentation)))
640: ;; Are we looking at a case expression ?
641: ((looking-at "|.*=>")
642: (sml-skip-block)
643: ;; Dont get fooled by fn _ => in case statements (890726)
644: (sml-re-search-backward "=>")
645: (let ((loop t))
646: (while (and loop (save-excursion
647: (beginning-of-line)
648: (looking-at ".*\\bfn\\b.*=>")))
649: (setq loop (sml-re-search-backward "=>"))))
650: (beginning-of-line)
651: (skip-chars-forward "\t ")
652: (cond
653: ((looking-at "|") (current-indentation))
654: ((and sml-case-indent (looking-at "of\\b"))
655: (1+ (current-indentation)))
656: ((looking-at "fn\\b") (1+ (current-indentation)))
657: ((looking-at "handle\\b") (+ (current-indentation) 5))
658: (t (+ (current-indentation) sml-pipe-indent))))
659: ((looking-at "and\\b")
660: (if (sml-find-matching-starter sml-starters-reg)
661: (current-column)
662: 0))
663: ((looking-at "in\\b") ; Match the beginning let/local
664: (sml-find-match-indent "in" "\\bin\\b" "\\blocal\\b\\|\\blet\\b"))
665: ((looking-at "end\\b") ; Match the beginning
666: (sml-find-match-indent "end" "\\bend\\b" sml-end-starters-reg))
667: ((and sml-nested-if-indent (looking-at "else[\t ]*if\\b"))
668: (sml-re-search-backward "\\bif\\b\\|\\belse\\b")
669: (current-indentation))
670: ((looking-at "else\\b") ; Match the if
671: (sml-find-match-indent "else" "\\belse\\b" "\\bif\\b" t))
672: ((looking-at "then\\b") ; Match the if + extra indentation
673: (+ (sml-find-match-indent "then" "\\bthen\\b" "\\bif\\b" t)
674: sml-indent-level))
675: ((and sml-case-indent (looking-at "of\\b"))
676: (sml-re-search-backward "\\bcase\\b")
677: (+ (current-column) 2))
678: ((looking-at sml-starters-reg)
679: (let ((start (point)))
680: (sml-backward-sexp)
681: (if (and (looking-at sml-starters-indent-after)
682: (/= start (point)))
683: (+ (if sml-type-of-indent
684: (current-column)
685: (if (progn (beginning-of-line)
686: (skip-chars-forward "\t ")
687: (looking-at "|"))
688: (- (current-indentation) sml-pipe-indent)
689: (current-indentation)))
690: sml-indent-level)
691: (beginning-of-line)
692: (skip-chars-forward "\t ")
693: (if (and (looking-at sml-starters-indent-after)
694: (/= start (point)))
695: (+ (if sml-type-of-indent
696: (current-column)
697: (current-indentation))
698: sml-indent-level)
699: (goto-char start)
700: (if (sml-find-matching-starter sml-starters-reg)
701: (current-column)
702: 0)))))
703: (t
704: (let ((indent (sml-get-indent)))
705: (cond
706: ((looking-at "|")
707: ;; Lets see if it is the follower of a function definition
708: (if (sml-find-matching-starter
709: "\\bfun\\b\\|\\bfn\\b\\|\\band\\b\\|\\bhandle\\b")
710: (cond
711: ((looking-at "fun\\b") (- (current-column) sml-pipe-indent))
712: ((looking-at "fn\\b") (1+ (current-column)))
713: ((looking-at "and\\b") (1+ (1+ (current-column))))
714: ((looking-at "handle\\b") (+ (current-column) 5)))
715: (+ indent sml-pipe-indent)))
716: (t
717: (if sml-paren-lookback ; Look for open parenthesis ?
718: (max indent (sml-get-paren-indent))
719: indent))))))))
720:
721: (defun sml-get-indent ()
722: (save-excursion
723: (beginning-of-line)
724: (skip-chars-backward "\t\n; ")
725: (if (looking-at ";") (sml-backward-sexp))
726: (cond
727: ((save-excursion (sml-backward-sexp) (looking-at "end\\b"))
728: (- (current-indentation) sml-indent-level))
729: (t
730: (while (/= (current-column) (current-indentation))
731: (sml-backward-sexp))
732: (skip-chars-forward "\t |")
733: (let ((indent (current-column)))
734: (skip-chars-forward "\t (")
735: (cond
736: ;; Started val/fun/structure...
737: ((looking-at sml-indent-starters-reg)
738: (+ (current-column) sml-indent-level))
739: ;; Indent after "=>" pattern, but only if its not an fn _ =>
740: ;; (890726)
741: ((looking-at ".*=>")
742: (if (looking-at ".*\\bfn\\b.*=>")
743: indent
744: (+ indent sml-indent-level)))
745: ;; else keep the same indentation as previous line
746: (t indent)))))))
747:
748: (defun sml-get-paren-indent ()
749: (save-excursion
750: (let ((levelpar 0) ; Level of "()"
751: (levelcurl 0) ; Level of "{}"
752: (levelsqr 0) ; Level of "[]"
753: (backpoint (max (- (point) sml-paren-lookback) (point-min)))
754: (loop t))
755: (while (and (/= levelpar 1) (/= levelsqr 1) (/= levelcurl 1) loop)
756: (if (re-search-backward "[][{}()]" backpoint t)
757: (if (not (sml-inside-comment-or-string-p))
758: (cond
759: ((looking-at "(") (setq levelpar (1+ levelpar)))
760: ((looking-at ")") (setq levelpar (1- levelpar)))
761: ((looking-at "\\[") (setq levelsqr (1+ levelsqr)))
762: ((looking-at "\\]") (setq levelsqr (1- levelsqr)))
763: ((looking-at "{") (setq levelcurl (1+ levelcurl)))
764: ((looking-at "}") (setq levelcurl (1- levelcurl)))))
765: (setq loop nil)))
766: (if loop
767: (1+ (current-column))
768: 0))))
769:
770: (defun sml-inside-comment-or-string-p ()
771: (let ((start (point)))
772: (if (save-excursion
773: (condition-case ()
774: (progn
775: (search-backward "(*")
776: (search-forward "*)")
777: (forward-char -1) ; A "*)" is not inside the comment
778: (> (point) start))
779: (error nil)))
780: t
781: (let ((numb 0))
782: (save-excursion
783: (save-restriction
784: (narrow-to-region (progn (beginning-of-line) (point)) start)
785: (condition-case ()
786: (while t
787: (search-forward "\"")
788: (setq numb (1+ numb)))
789: (error (if (and (not (zerop numb))
790: (not (zerop (% numb 2))))
791: t nil)))))))))
792:
793: (defun sml-skip-block ()
794: (sml-backward-sexp)
795: (if (looking-at "end\\b")
796: (progn
797: (goto-char (sml-find-match-backward "end" "\\bend\\b"
798: sml-end-starters-reg))
799: (skip-chars-backward "\n\t "))
800: ;; Here we will need to skip backward past if-then-else
801: ;; and case-of expression. Please - tell me how !!
802: ))
803:
804: (defun sml-find-match-backward (unquoted-this this match &optional start)
805: (save-excursion
806: (let ((level 1)
807: (pattern (concat this "\\|" match)))
808: (if start (goto-char start))
809: (while (not (zerop level))
810: (if (sml-re-search-backward pattern)
811: (setq level (cond
812: ((looking-at this) (1+ level))
813: ((looking-at match) (1- level))))
814: ;; The right match couldn't be found
815: (error (concat "Unbalanced: " unquoted-this))))
816: (point))))
817:
818: (defun sml-find-match-indent (unquoted-this this match &optional indented)
819: (save-excursion
820: (goto-char (sml-find-match-backward unquoted-this this match))
821: (if (or sml-type-of-indent indented)
822: (current-column)
823: (if (progn
824: (beginning-of-line)
825: (skip-chars-forward "\t ")
826: (looking-at "|"))
827: (- (current-indentation) sml-pipe-indent)
828: (current-indentation)))))
829:
830: (defun sml-find-matching-starter (regexp)
831: (let ((start-let-point (sml-point-inside-let-etc))
832: (start-up-list (sml-up-list))
833: (found t))
834: (if (sml-re-search-backward regexp)
835: (progn
836: (condition-case ()
837: (while (or (/= start-up-list (sml-up-list))
838: (/= start-let-point (sml-point-inside-let-etc)))
839: (re-search-backward regexp))
840: (error (setq found nil)))
841: found)
842: nil)))
843:
844: (defun sml-point-inside-let-etc ()
845: (let ((last nil) (loop t) (found t) (start (point)))
846: (save-excursion
847: (while loop
848: (condition-case ()
849: (progn
850: (re-search-forward "\\bend\\b")
851: (while (sml-inside-comment-or-string-p)
852: (re-search-forward "\\bend\\b"))
853: (forward-char -3)
854: (setq last (sml-find-match-backward "end" "\\bend\\b"
855: sml-end-starters-reg last))
856: (if (< last start)
857: (setq loop nil)
858: (forward-char 3)))
859: (error (progn (setq found nil) (setq loop nil)))))
860: (if found
861: last
862: 0))))
863:
864: (defun sml-re-search-backward (regexpr)
865: (let ((found t))
866: (if (re-search-backward regexpr nil t)
867: (progn
868: (condition-case ()
869: (while (sml-inside-comment-or-string-p)
870: (re-search-backward regexpr))
871: (error (setq found nil)))
872: found)
873: nil)))
874:
875: (defun sml-up-list ()
876: (save-excursion
877: (condition-case ()
878: (progn
879: (up-list 1)
880: (point))
881: (error 0))))
882:
883: (defun sml-backward-sexp ()
884: (condition-case ()
885: (progn
886: (let ((start (point)))
887: (backward-sexp 1)
888: (while (and (/= start (point)) (looking-at "(\\*"))
889: (setq start (point))
890: (backward-sexp 1))))
891: (error (forward-char -1))))
892:
893: (defun sml-comment-indent ()
894: (if (looking-at "^(\\*") ; Existing comment at beginning
895: 0 ; of line stays there.
896: (save-excursion
897: (skip-chars-backward " \t")
898: (1+ (max (current-column) ; Else indent at comment column
899: comment-column))))) ; except leave at least one space.
900:
901:
902: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
903: ;;;
904: ;;; INFERIOR SHELL
905: ;;;
906: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
907:
908: (defvar sml-shell-map nil "The mode map for sml-shell.")
909:
910: (defun sml-shell ()
911: "Inferior shell invoking SML.
912: It is not possible to have more than one shell running SML.
913: Like the shell mode with the additional command:
914:
915: \\[sml-run-on-file]\t Runs sml on the file.
916: \\{sml-shell-map}
917: Variables controlling the mode:
918:
919: sml-prog-name (default \"sml\")
920: The string used to invoke the sml program.
921:
922: sml-prog-name-ask-p (default nil)
923: If t, you will be asked which program to run when the inferior
924: shell starts up. Usefull if you have exported images of sml.
925:
926: sml-use-right-delim (default \"\\\"\")
927: sml-use-left-delim (default \"\\\"\")
928: The left and right delimiter used by your version of sml, for
929: \"use file-name\".
930:
931: sml-process-name (default \"SML\")
932: The name of the process running sml.
933:
934: sml-shell-prompt-pattern (default \"^[^\\-=]*[\\-=] *\")
935: The prompt pattern.
936:
937: Runs sml-shell-hook if not nil."
938: (interactive)
939: (if (not (process-status sml-process-name))
940: (save-excursion ; Process is not running
941: (and sml-prog-name-ask-p
942: (setq sml-prog-name
943: (read-file-name
944: (concat "Sml (default " sml-prog-name "): ")
945: (file-name-directory (buffer-file-name))
946: sml-prog-name)))
947: (message "Starting SML...") ; start up a new process
948: (require 'shell)
949: (set-buffer
950: (make-shell sml-process-name
951: (if (= (string-to-char sml-prog-name) ?~)
952: (expand-file-name sml-prog-name)
953: sml-prog-name)))
954: (erase-buffer) ; Erase the buffer if a previous
955: (if sml-shell-map ; process died in there
956: ()
957: (setq sml-shell-map (copy-sequence shell-mode-map))
958: (define-key sml-shell-map "\C-c\C-f" 'sml-run-on-file))
959: (use-local-map sml-shell-map)
960: (make-local-variable 'shell-prompt-pattern)
961: (setq shell-prompt-pattern sml-shell-prompt-pattern)
962: (setq major-mode 'sml-shell)
963: (setq mode-name "Sml-Shell")
964: (if sml-prog-name-ask-p
965: (setq mode-line-process
966: (list (concat
967: ": %s ("
968: (substring sml-prog-name
969: (string-match "[^/]*$" sml-prog-name)
970: (string-match "$" sml-prog-name))
971: ")"))))
972: (set-process-filter (get-process sml-process-name) 'sml-process-filter)
973: (message "Starting SML... done.")
974: (run-hooks 'sml-shell-hook))))
975:
976: (defun sml-process-filter (proc str)
977: (let ((cur (selected-window))
978: (pop-up-windows t)
979: (process (concat "*" sml-process-name "*")))
980: (pop-to-buffer process)
981: (goto-char (point-max))
982: (insert str)
983: (set-marker (process-mark proc) (point-max))
984: (select-window cur)))
985:
986: (defun sml-pop-to-shell ()
987: "Pop to the buffer running SML"
988: (interactive)
989: (sml-shell)
990: (pop-to-buffer (concat "*" sml-process-name "*")))
991:
992: (defun sml-run-on-file (fil)
993: "Send a use FILE to the inferior shell running sml"
994: (interactive "FUse file: ")
995: (sml-shell)
996: (save-some-buffers)
997: (sml-skip-errors)
998: (send-string sml-process-name
999: (concat "use " sml-use-left-delim (expand-file-name fil)
1000: sml-use-right-delim ";\n")))
1001:
1002: (defun sml-save-buffer-use-file ()
1003: "Save the buffer, and send a `use file' to the inferior shell
1004: running SML."
1005: (interactive)
1006: (let (file)
1007: (if (setq file (buffer-file-name)) ; Is the buffer associated
1008: (progn ; with file ?
1009: (save-buffer)
1010: (sml-shell)
1011: (sml-skip-errors)
1012: (message (concat "use " sml-use-left-delim file sml-use-right-delim))
1013: (send-string sml-process-name
1014: (concat "use " sml-use-left-delim
1015: (expand-file-name file)
1016: sml-use-right-delim ";\n")))
1017: (error "Buffer not associated with file."))))
1018:
1019: (defun sml-import-file ()
1020: "Save the buffer, and send an `import file' to the inferior shell
1021: running SML."
1022: (interactive)
1023: (let (file)
1024: (if (setq file (buffer-file-name))
1025: (if (string-match ".sml$" file)
1026: (progn
1027: (setq file (substring file 0 (string-match ".sml$" file)))
1028: (save-buffer)
1029: (sml-shell)
1030: (sml-skip-errors)
1031: (message (concat "import \"" file "\""))
1032: (send-string sml-process-name
1033: (concat "import " sml-use-left-delim
1034: (expand-file-name file)
1035: sml-use-right-delim ";\n")))
1036: (error "Filename doesn't match \"*.sml\""))
1037: (error "Buffer not associated with file."))))
1038:
1039: (defvar sml-tmp-files-list nil
1040: "List of all temporary files created by sml-simulate-send-region.
1041: Each element in the list is a list with the format:
1042: \n (\"tmp-filename\" buffer start-line)")
1043:
1044: (defvar sml-simulate-send-region-called-p nil
1045: "Has sml-simulate-send-region been called previously.")
1046:
1047: (defun sml-simulate-send-region (point1 point2)
1048: "Simulate send region. As send-region only can handle what ever the
1049: system sets as the default, we have to make a temporary file.
1050: Updates the list of temporary files (sml-tmp-files-list)."
1051: (let ((file (expand-file-name (make-temp-name sml-tmp-template))))
1052: ;; Remove temporary files when we leave emacs
1053: (if (not sml-simulate-send-region-called-p)
1054: (progn
1055: (setq sml-old-kill-emacs-hook kill-emacs-hook)
1056: (setq kill-emacs-hook 'sml-remove-tmp-files)
1057: (setq sml-simulate-send-region-called-p t)))
1058: ;; As make-temp-name can only make 26 unique file names with the
1059: ;; same template (bug in Un*x function mktemp), we add a new
1060: ;; letter to sml-tmp-template.
1061: (if (zerop (% (length sml-tmp-files-list) 25))
1062: (setq sml-tmp-template (concat sml-tmp-template "A")))
1063: (save-excursion
1064: (goto-char point1)
1065: (setq sml-tmp-files-list
1066: (cons (list file
1067: (current-buffer)
1068: (save-excursion ; Calculate line no.
1069: (beginning-of-line)
1070: (1+ (count-lines 1 (point)))))
1071: sml-tmp-files-list)))
1072: (write-region point1 point2 file nil 'dummy)
1073: (sml-shell)
1074: (message "Using temporary file: %s" file)
1075: (send-string
1076: sml-process-name
1077: ;; string to send: use file;
1078: (concat "use " sml-use-left-delim file sml-use-right-delim ";\n"))))
1079:
1080: (defvar sml-old-kill-emacs-hook nil
1081: "Old value of kill-emacs-hook")
1082:
1083: (defun sml-remove-tmp-files ()
1084: "Remove the temporary files, created by sml-simulate-send-region, if
1085: they still exist. Only files recorded in sml-tmp-files-list are removed."
1086: (message "Removing temporary files created by sml-mode...")
1087: (while sml-tmp-files-list
1088: (condition-case ()
1089: (delete-file (car (car sml-tmp-files-list)))
1090: (error ()))
1091: (setq sml-tmp-files-list (cdr sml-tmp-files-list)))
1092: (message "Removing temporary files created by sml-mode... done.")
1093: (run-hooks 'sml-old-kill-emacs-hook))
1094:
1095: (defun sml-send-region ()
1096: "Send region to inferior shell running SML."
1097: (interactive)
1098: (sml-shell)
1099: (sml-skip-errors)
1100: (let (start end)
1101: (save-excursion
1102: (setq end (point))
1103: (exchange-point-and-mark)
1104: (setq start (point)))
1105: (sml-simulate-send-region start end)))
1106:
1107: (defun sml-send-function ()
1108: "Does NOT send the function, but the paragraph, to inferior shell
1109: running SML"
1110: (interactive)
1111: (sml-shell)
1112: (sml-skip-errors)
1113: (let (start end)
1114: (save-excursion
1115: (condition-case ()
1116: (progn
1117: (backward-paragraph)
1118: (setq start (point)))
1119: (error (setq start (point-min))))
1120: (condition-case ()
1121: (progn
1122: (forward-paragraph)
1123: (setq end (point)))
1124: (error (setq end (point-max)))))
1125: (sml-simulate-send-region start end)))
1126:
1127: (defun sml-send-buffer ()
1128: "Send the buffer, to inferior shell running SML"
1129: (interactive)
1130: (sml-shell)
1131: (sml-skip-errors)
1132: (sml-simulate-send-region (point-min) (point-max)))
1133:
1134: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1135: ;;;
1136: ;;; END OF SML-MODE
1137: ;;;
1138: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1139:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.