Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml-mode/trunk/sml-mode.el
ViewVC logotype

Diff of /sml-mode/trunk/sml-mode.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 318, Mon Jun 7 09:32:09 1999 UTC revision 319, Mon Jun 7 22:47:00 1999 UTC
# Line 1  Line 1 
1  ;;; sml-mode.el. Major mode for editing (Standard) ML. Version 3.3(beta)  ;;; sml-mode.el. Major mode for editing (Standard) ML. Version 3.3(beta)
2    
3  ;; Copyright (C) 1989, Lars Bo Nielsen; 1994,1997, Matthew J. Morley  (defconst rcsid-sml-mode "@(#)$Name$:$Id$")
4    
5    ;; Copyright (C) 1989-1999, Lars Bo Nielsen; 1994,1997, Matthew J. Morley
6    
7  ;; $Revision$  ;; $Revision$
8  ;; $Date$  ;; $Date$
# Line 37  Line 39 
39  ;; font-lock patterns, some of Steven Gilmore's (reduced) easy-menus,  ;; font-lock patterns, some of Steven Gilmore's (reduced) easy-menus,
40  ;; and numerous bugs and bug-fixes.  ;; and numerous bugs and bug-fixes.
41    
42    ;; Author: Lars Bo Nielsen
43    ;;      Olin Shivers
44    ;;      Fritz Knabe (?)
45    ;;      Steven Gilmore (?)
46    ;;      Matthew Morley <mjm@scs.leeds.ac.uk> (aka <matthew@verisity.com>)
47    ;;      Matthias Blume <blume@cs.princeton.edu> (aka <blume@kurims.kyoto-u.ac.jp>)
48    ;;      (Stefan Monnier) monnier@cs.yale.edu
49    ;; Maintainer: (Stefan Monnier) monnier+lists/emacs/sml@tequila.cs.yale.edu
50    ;; Keywords: SML
51    
52  ;;; DESCRIPTION  ;;; DESCRIPTION
53    
54  ;; See accompanying info file: sml-mode.info  ;; See accompanying info file: sml-mode.info
# Line 96  Line 108 
108    "sml-mode, version 3.3")    "sml-mode, version 3.3")
109    
110  (require 'cl)  (require 'cl)
111  (provide 'sml-mode)  (require 'sml-util)
112    (require 'sml-move)
113    (require 'sml-defs)
114    
115  ;;; VARIABLES CONTROLLING INDENTATION  ;;; VARIABLES CONTROLLING INDENTATION
116    
# Line 146  Line 160 
160            else if exp5 then exp6                         else if exp5 then exp6            else if exp5 then exp6                         else if exp5 then exp6
161            else exp7                                           else exp7")            else exp7                                           else exp7")
162    
163  (defvar sml-type-of-indent t  (defvar sml-type-of-indent nil
164    "*How to indent `let' `struct' etc.    "*How to indent `let' `struct' etc.
165      If t:  fun foo bar = let              If nil:  fun foo bar = let      If t:  fun foo bar = let              If nil:  fun foo bar = let
166                               val p = 4                 val p = 4                               val p = 4                 val p = 4
# Line 209  Line 223 
223    (interactive)    (interactive)
224    (require 'info)    (require 'info)
225    (condition-case nil    (condition-case nil
226        (funcall 'Info-goto-node (concat "(" sml-mode-info ")"))        (Info-goto-node (concat "(" sml-mode-info ")"))
227      (error (progn      (error (progn
228               (describe-variable 'sml-mode-info)               (describe-variable 'sml-mode-info)
229               (message "Can't find it... set this variable first!")))))               (message "Can't find it... set this variable first!")))))
230    
 (defun sml-indent-level (&optional indent)  
    "Allow the user to change the block indentation level. Numeric prefix  
 accepted in lieu of prompting."  
    (interactive "NIndentation level: ")  
    (setq sml-indent-level indent))  
   
 (defun sml-pipe-indent (&optional indent)  
   "Allow to change pipe indentation level (usually negative). Numeric prefix  
 accepted in lieu of prompting."  
    (interactive "NPipe Indentation level: ")  
    (setq sml-pipe-indent indent))  
   
 (defun sml-case-indent (&optional of)  
   "Toggle sml-case-indent. Prefix means set it to nil."  
   (interactive "P")  
   (setq sml-case-indent (and (not of) (not sml-case-indent)))  
   (if sml-case-indent (message "%s" "true") (message "%s" nil)))  
   
 (defun sml-nested-if-indent (&optional of)  
   "Toggle sml-nested-if-indent. Prefix means set it to nil."  
   (interactive "P")  
   (setq sml-nested-if-indent (and (not of) (not sml-nested-if-indent)))  
   (if sml-nested-if-indent (message "%s" "true") (message "%s" nil)))  
   
 (defun sml-type-of-indent (&optional of)  
   "Toggle sml-type-of-indent. Prefix means set it to nil."  
   (interactive "P")  
   (setq sml-type-of-indent (and (not of) (not sml-type-of-indent)))  
   (if sml-type-of-indent (message "%s" "true") (message "%s" nil)))  
   
 (defun sml-electric-semi-mode (&optional of)  
   "Toggle sml-electric-semi-mode. Prefix means set it to nil."  
   (interactive "P")  
   (setq sml-electric-semi-mode (and (not of) (not sml-electric-semi-mode)))  
   (message "%s" (concat "Electric semi mode is "  
                    (if sml-electric-semi-mode "on" "off"))))  
   
 ;;; BINDINGS: these should be common to the source and process modes...  
   
 (defun install-sml-keybindings (map)  
   ;; Text-formatting commands:  
   (define-key map "\C-c\C-m" 'sml-insert-form)  
   (define-key map "\C-c\C-i" 'sml-mode-info)  
   (define-key map "\M-|"     'sml-electric-pipe)  
   (define-key map "\;"       'sml-electric-semi)  
   (define-key map "\M-\t"    'sml-back-to-outer-indent)  
   (define-key map "\C-\M-\\" 'sml-indent-region)  
   (define-key map "\t"       'sml-indent-line) ; ...except this one  
   ;; Process commands added to sml-mode-map -- these should autoload  
   (define-key map "\C-c\C-l" 'sml-load-file)  
   (define-key map "\C-c`"    'sml-next-error))  
231    
232  ;;; Autoload functions -- no-doc is another idea cribbed from AucTeX!  ;;; Autoload functions -- no-doc is another idea cribbed from AucTeX!
233    
234  (defvar sml-no-doc  (let ((sml-no-doc
235    "This function is part of sml-proc, and has not yet been loaded.    "This function is part of sml-proc, and has not yet been loaded.
236  Full documentation will be available after autoloading the function."  Full documentation will be available after autoloading the function."))
   "Documentation for autoloading functions.")  
237    
238  (autoload 'run-sml         "sml-proc"   sml-no-doc t)  (autoload 'run-sml         "sml-proc"   sml-no-doc t)
239  (autoload 'sml-make        "sml-proc"   sml-no-doc t)  (autoload 'sml-make        "sml-proc"   sml-no-doc t)
# Line 280  Line 242 
242  (autoload 'switch-to-sml   "sml-proc"   sml-no-doc t)  (autoload 'switch-to-sml   "sml-proc"   sml-no-doc t)
243  (autoload 'sml-send-region "sml-proc"   sml-no-doc t)  (autoload 'sml-send-region "sml-proc"   sml-no-doc t)
244  (autoload 'sml-send-buffer "sml-proc"   sml-no-doc t)  (autoload 'sml-send-buffer "sml-proc"   sml-no-doc t)
245  (autoload 'sml-next-error  "sml-proc"   sml-no-doc t)    (autoload 'sml-next-error  "sml-proc"   sml-no-doc t))
   
 (defvar sml-mode-map nil "The keymap used in sml-mode.")  
 (cond ((not sml-mode-map)  
        (setq sml-mode-map (make-sparse-keymap))  
        (install-sml-keybindings sml-mode-map)  
        (define-key sml-mode-map "\C-c\C-c" 'sml-make)  
        (define-key sml-mode-map "\C-c\C-s" 'switch-to-sml)  
        (define-key sml-mode-map "\C-c\C-r" 'sml-send-region)  
        (define-key sml-mode-map "\C-c\C-b" 'sml-send-buffer)))  
246    
247  ;; font-lock setup  ;; font-lock setup
248    
249  (defconst sml-keywords-regexp  (defconst sml-keywords-regexp
250    (eval-when-compile    (sml-syms-re "abstraction" "abstype" "and" "andalso" "as" "before" "case"
     (concat  
      "\\<"  
      (regexp-opt '("abstraction" "abstype" "and" "andalso" "as" "before" "case"  
251                     "datatype" "else" "end" "eqtype" "exception" "do" "fn"                     "datatype" "else" "end" "eqtype" "exception" "do" "fn"
252                     "fun" "functor" "handle" "if" "in" "include" "infix"                     "fun" "functor" "handle" "if" "in" "include" "infix"
253                     "infixr" "let" "local" "nonfix" "of" "op" "open" "orelse"                     "infixr" "let" "local" "nonfix" "of" "op" "open" "orelse"
254                     "overload" "raise" "rec" "sharing" "sig" "signature"                     "overload" "raise" "rec" "sharing" "sig" "signature"
255                     "struct" "structure" "then" "type" "val" "where" "while"                     "struct" "structure" "then" "type" "val" "where" "while"
256                     "with" "withtype") t)                 "with" "withtype")
      "\\>"))  
257    "A regexp that matches any and all keywords of SML.")    "A regexp that matches any and all keywords of SML.")
258    
259  (defconst sml-font-lock-keywords  (defconst sml-font-lock-keywords
260    `(;;(sml-font-comments-and-strings)    `(;;(sml-font-comments-and-strings)
261      ("\\<\\(fun\\|and\\)\\s-+\\(\\(\\sw\\|\\s_\\)+\\)"      ("\\<\\(fun\\|and\\)\\s-+\\(\\sw+\\)"
262       (1 font-lock-keyword-face)       (1 font-lock-keyword-face)
263       (2 font-lock-function-def-face))       (2 font-lock-function-def-face))
264      ("\\<\\(\\(data\\|abs\\|with\\|eq\\)?type\\)\\s-+\\('\\s-*\\(\\sw\\|\\s_\\)+\\s-+\\)*\\(\\(\\sw\\|\\s_\\)+\\)"      ("\\<\\(\\(data\\|abs\\|with\\|eq\\)?type\\)\\s-+\\('\\s-*\\sw+\\s-+\\)*\\(\\sw+\\)"
265       (1 font-lock-keyword-face)       (1 font-lock-keyword-face)
266       (5 font-lock-type-def-face))       (4 font-lock-type-def-face))
267      ("\\<\\(val\\)\\s-+\\(\\(\\sw\\|\\s_\\)+\\>\\s-*\\)?\\(\\(\\sw\\|\\s_\\)+\\)\\s-*="      ("\\<\\(val\\)\\s-+\\(\\sw+\\>\\s-*\\)?\\(\\sw+\\)\\s-*="
268       (1 font-lock-keyword-face)       (1 font-lock-keyword-face)
269       ;;(6 font-lock-variable-def-face nil t)       ;;(6 font-lock-variable-def-face nil t)
270       (4 font-lock-variable-def-face))       (3 font-lock-variable-def-face))
271      ("\\<\\(structure\\|functor\\|abstraction\\)\\s-+\\(\\(\\sw\\|\\s_\\)+\\)"      ("\\<\\(structure\\|functor\\|abstraction\\)\\s-+\\(\\sw+\\)"
272       (1 font-lock-keyword-face)       (1 font-lock-keyword-face)
273       (2 font-lock-module-def-face))       (2 font-lock-module-def-face))
274      ("\\<\\(signature\\)\\s-+\\(\\(\\sw\\|\\s_\\)+\\)"      ("\\<\\(signature\\)\\s-+\\(\\sw+\\)"
275       (1 font-lock-keyword-face)       (1 font-lock-keyword-face)
276       (2 font-lock-interface-def-face))       (2 font-lock-interface-def-face))
277    
# Line 343  Line 292 
292    (def-face 'font-lock-interface-def-face 'font-lock-type-face)    (def-face 'font-lock-interface-def-face 'font-lock-type-face)
293    (def-face 'font-lock-variable-def-face 'font-lock-variable-name-face))    (def-face 'font-lock-variable-def-face 'font-lock-variable-name-face))
294    
295  ;; (setq sml-alt-syntax-table  (defvar sml-syntax-prop-table
296  ;;       (let ((st (make-syntax-table)))    (let ((st (make-syntax-table)))
297  ;;      (modify-syntax-entry ?l "(d" st)      (modify-syntax-entry ?l "(d" st)
298  ;;      (modify-syntax-entry ?d ")l" st)      (modify-syntax-entry ?s "(d" st)
299  ;;      (modify-syntax-entry ?\) ")(" st)      (modify-syntax-entry ?d ")l" st)
300  ;;      st))      (modify-syntax-entry ?* "." st)
301        st))
302    
303  (defun sml-get-depth-st ()  (defun sml-get-depth-st ()
304    (save-excursion    (save-excursion
# Line 366  Line 316 
316                      0)))                      0)))
317                 (depth (if (> depth 0) depth)))                 (depth (if (> depth 0) depth)))
318            (put-text-property pt (1+ pt) 'comment-depth depth)            (put-text-property pt (1+ pt) 'comment-depth depth)
319            (when depth '(?.)))))))            (when depth sml-syntax-prop-table))))))
320    
321  (defconst sml-font-lock-syntactic-keywords  (defconst sml-font-lock-syntactic-keywords
322    '(;;("\\<\\(l\\)et\\>" (1 (?\( . ?d))) ;; sml-alt-syntax-table))    `(;;("\\<\\(l\\)\\(et\\|ocal\\)\\>" (1 ',sml-syntax-prop-table))
323      ;;("\\<en\\(d\\)\\>" (1 (?\) . ?l))) ;;sml-alt-syntax-table))      ;;("\\<\\(s\\)\\(ig\\truct\\)\\>" (1 ',sml-syntax-prop-table))
324        ;;("\\<en\\(d\\)\\>" (1 ',sml-syntax-prop-table))
325      ("(?\\(\\*\\))?" (1 (sml-get-depth-st)))))      ("(?\\(\\*\\))?" (1 (sml-get-depth-st)))))
326    
327  (defconst sml-font-lock-defaults  (defconst sml-font-lock-defaults
328    '(sml-font-lock-keywords nil nil nil nil    '(sml-font-lock-keywords nil nil ((?_ . "w") (?' . "w")) nil
329                             (font-lock-syntactic-keywords . sml-font-lock-syntactic-keywords)))                             (font-lock-syntactic-keywords . sml-font-lock-syntactic-keywords)))
330    
331  ;; code to get comment fontification working in the face of recursive  ;; code to get comment fontification working in the face of recursive
# Line 434  Line 385 
385    
386  ;;; H A C K   A T T A C K !   X E M A C S   V E R S U S   E M A C S  ;;; H A C K   A T T A C K !   X E M A C S   V E R S U S   E M A C S
387    
388  (cond ((fboundp 'make-extent)  ;; (cond ((fboundp 'make-extent)
389         ;; suppose this is XEmacs  ;;        ;; suppose this is XEmacs
390    
391         (defun sml-make-overlay ()  ;;        (defun sml-make-overlay ()
392           "Create a new text overlay (extent) for the SML buffer."  ;;          "Create a new text overlay (extent) for the SML buffer."
393           (let ((ex (make-extent 1 1)))  ;;          (let ((ex (make-extent 1 1)))
394             (set-extent-property ex 'face 'zmacs-region) ex))  ;;            (set-extent-property ex 'face 'zmacs-region) ex))
395    
396         (defalias 'sml-is-overlay 'extentp)  ;;        (defalias 'sml-is-overlay 'extentp)
397    
398         (defun sml-overlay-active-p ()  ;;        (defun sml-overlay-active-p ()
399           "Determine whether the current buffer's error overlay is visible."  ;;          "Determine whether the current buffer's error overlay is visible."
400           (and (sml-is-overlay sml-error-overlay)  ;;          (and (sml-is-overlay sml-error-overlay)
401                (not (zerop (extent-length sml-error-overlay)))))  ;;               (not (zerop (extent-length sml-error-overlay)))))
402    
403         (defalias 'sml-move-overlay 'set-extent-endpoints))  ;;        (defalias 'sml-move-overlay 'set-extent-endpoints))
404    
405        ((fboundp 'make-overlay)  ;;       ((fboundp 'make-overlay)
406         ;; otherwise assume it's Emacs         ;; otherwise assume it's Emacs
407    
408         (defun sml-make-overlay ()         (defun sml-make-overlay ()
# Line 467  Line 418 
418                (not (equal (overlay-start sml-error-overlay)                (not (equal (overlay-start sml-error-overlay)
419                            (overlay-end sml-error-overlay)))))                            (overlay-end sml-error-overlay)))))
420    
421         (defalias 'sml-move-overlay 'move-overlay))         (defalias 'sml-move-overlay 'move-overlay);;)
422        (t  ;;       (t
423         ;; what *is* this!?  ;;        ;; what *is* this!?
424         (defalias 'sml-is-overlay 'ignore)  ;;        (defalias 'sml-is-overlay 'ignore)
425         (defalias 'sml-overlay-active-p 'ignore)  ;;        (defalias 'sml-overlay-active-p 'ignore)
426         (defalias 'sml-make-overlay 'ignore)  ;;        (defalias 'sml-make-overlay 'ignore)
427         (defalias 'sml-move-overlay 'ignore)))  ;;        (defalias 'sml-move-overlay 'ignore)))
428    
429  ;;; MORE CODE FOR SML-MODE  ;;; MORE CODE FOR SML-MODE
430    
# Line 482  Line 433 
433    (interactive)    (interactive)
434    (message sml-mode-version-string))    (message sml-mode-version-string))
435    
 (defvar sml-mode-syntax-table nil "The syntax table used in sml-mode.")  
 (if sml-mode-syntax-table  
     ()  
   (setq sml-mode-syntax-table (make-syntax-table))  
   ;; Set everything to be "." (punctuation) except for [A-Za-z0-9],  
   ;; which will default to "w" (word-constituent).  
   (let ((i 0))  
     (while (< i ?0)  
       (modify-syntax-entry i "." sml-mode-syntax-table)  
       (setq i (1+ i)))  
     (setq i (1+ ?9))  
     (while (< i ?A)  
       (modify-syntax-entry i "." sml-mode-syntax-table)  
       (setq i (1+ i)))  
     (setq i (1+ ?Z))  
     (while (< i ?a)  
       (modify-syntax-entry i "." sml-mode-syntax-table)  
       (setq i (1+ i)))  
     (setq i (1+ ?z))  
     (while (< i 128)  
       (modify-syntax-entry i "." sml-mode-syntax-table)  
       (setq i (1+ i))))  
   
   ;; Now we change the characters that are meaningful to us.  
   (modify-syntax-entry ?.       "_"     sml-mode-syntax-table)  
   (modify-syntax-entry ?\\      "\\"    sml-mode-syntax-table)  
   (modify-syntax-entry ?\(      "()1"   sml-mode-syntax-table)  
   (modify-syntax-entry ?\)      ")(4"   sml-mode-syntax-table)  
   (modify-syntax-entry ?\[      "(]"    sml-mode-syntax-table)  
   (modify-syntax-entry ?\]      ")["    sml-mode-syntax-table)  
   (modify-syntax-entry ?{       "(}"    sml-mode-syntax-table)  
   (modify-syntax-entry ?}       "){"    sml-mode-syntax-table)  
   (modify-syntax-entry ?\*      ". 23"  sml-mode-syntax-table)  
   (modify-syntax-entry ?\"      "\""    sml-mode-syntax-table)  
   (modify-syntax-entry ?        " "     sml-mode-syntax-table)  
   (modify-syntax-entry ?\t      " "     sml-mode-syntax-table)  
   (modify-syntax-entry ?\n      " "     sml-mode-syntax-table)  
   (modify-syntax-entry ?\f      " "     sml-mode-syntax-table)  
   (modify-syntax-entry ?\'      "_"     sml-mode-syntax-table)  
   (modify-syntax-entry ?\_      "_"     sml-mode-syntax-table))  
   
436  ;;;###Autoload  ;;;###Autoload
437  (defun sml-mode ()  (defun sml-mode ()
438    "Major mode for editing ML code.    "Major mode for editing ML code.
# Line 553  Line 463 
463  sml-nested-if-indent (default nil)  sml-nested-if-indent (default nil)
464      Determine how nested if-then-else expressions are formatted.      Determine how nested if-then-else expressions are formatted.
465    
466  sml-type-of-indent (default t)  sml-type-of-indent (default nil)
467      How to indent let, struct, local, etc.      How to indent let, struct, local, etc.
468      Will not have any effect if the starting keyword is first on the line.      Will not have any effect if the starting keyword is first on the line.
469    
# Line 574  Line 484 
484    (use-local-map sml-mode-map)    (use-local-map sml-mode-map)
485    (setq major-mode 'sml-mode)    (setq major-mode 'sml-mode)
486    (setq mode-name "SML")    (setq mode-name "SML")
487      (set (make-local-variable 'outline-regexp) sml-outline-regexp)
488    (run-hooks 'sml-mode-hook))            ; Run the hook last    (run-hooks 'sml-mode-hook))            ; Run the hook last
489    
490  (defun sml-mode-variables ()  (defun sml-mode-variables ()
# Line 591  Line 502 
502    (set (make-local-variable 'comment-start-skip) "(\\*+[ \t]?")    (set (make-local-variable 'comment-start-skip) "(\\*+[ \t]?")
503    (set (make-local-variable 'comment-indent-function) 'sml-comment-indent)    (set (make-local-variable 'comment-indent-function) 'sml-comment-indent)
504    (set (make-local-variable 'font-lock-defaults) sml-font-lock-defaults)    (set (make-local-variable 'font-lock-defaults) sml-font-lock-defaults)
505    (set (make-local-variable 'parse-sexp-lookup-properties) t)    ;;(set (make-local-variable 'parse-sexp-lookup-properties) t)
506    (set (make-local-variable 'parse-sexp-ignore-comments) t)    ;;(set (make-local-variable 'parse-sexp-ignore-comments) t)
507    (setq sml-error-overlay (and sml-error-overlay (sml-make-overlay))))    (setq sml-error-overlay (and sml-error-overlay (sml-make-overlay))))
508    
   ;; Adding these will fool the matching of parens -- because of a  
   ;; bug in Emacs (in scan_lists, i think)... it would be nice to  
   ;; have comments treated as white-space.  
   ;;(make-local-variable 'parse-sexp-ignore-comments)  
   ;;(setq parse-sexp-ignore-comments t)  
   
509  (defun sml-error-overlay (undo &optional beg end buffer)  (defun sml-error-overlay (undo &optional beg end buffer)
510    "Move `sml-error-overlay' so it surrounds the text region in the    "Move `sml-error-overlay' so it surrounds the text region in the
511  current buffer. If the buffer-local variable `sml-error-overlay' is  current buffer. If the buffer-local variable `sml-error-overlay' is
# Line 623  Line 528 
528                  (end (or end (region-end))))                  (end (or end (region-end))))
529              (sml-move-overlay sml-error-overlay beg end))))))              (sml-move-overlay sml-error-overlay beg end))))))
530    
 (defconst sml-pipe-matchers-reg  
   (eval-when-compile  
     (concat  
      "\\<"  
      (regexp-opt '("case" "fn" "fun" "handle" "datatype" "abstype" "and") t)  
      "\\>"))  
   "The keywords a `|' can follow.")  
   
531  (defun sml-electric-pipe ()  (defun sml-electric-pipe ()
532    "Insert a \"|\".    "Insert a \"|\".
533  Depending on the context insert the name of function, a \"=>\" etc."  Depending on the context insert the name of function, a \"=>\" etc."
534    (interactive)    (interactive)
535    (let ((case-fold-search nil)          ; Case sensitive    (sml-with-ist
536          (here (point))     (let ((text
         (match (save-excursion  
                  (sml-find-matching-starter sml-pipe-matchers-reg)  
                  (point)))  
         (tmp "  => ")  
         (case-or-handle-exp t))  
     (if (/= (save-excursion (beginning-of-line) (point))  
             (save-excursion (skip-chars-backward "\t ") (point)))  
         (insert "\n"))  
     (insert "|")  
537      (save-excursion      (save-excursion
538        (goto-char match)              (sml-find-matching-starter sml-pipehead-re)
539        (cond        (cond
540         ;; It was a function, insert the function name         ;; It was a function, insert the function name
541         ((looking-at "fun\\b")               ((or (looking-at "fun\\>")
542          (setq tmp (concat " " (buffer-substring                    (and (looking-at "and\\>")
                                (progn (forward-char 3)  
                                       (skip-chars-forward "\t\n ") (point))  
                                (progn (forward-word 1) (point))) " "))  
         (setq case-or-handle-exp nil))  
        ;; It was a datatype, insert nothing  
        ((looking-at "datatype\\b\\|abstype\\b")  
         (setq tmp " ") (setq case-or-handle-exp nil))  
        ;; If it is an and, then we have to see what is was  
        ((looking-at "and\\b")  
         (let (isfun)  
543            (save-excursion            (save-excursion
544              (condition-case ()                           (sml-find-matching-starter
545                  (progn                            (sml-syms-re "datatype" "abstype" "fun"))
546                    (re-search-backward "datatype\\b\\|abstype\\b\\|fun\\b")                           (looking-at "fun\\>"))))
547                    (setq isfun (looking-at "fun\\b")))                (forward-word 1) (sml-forward-spaces)
548                (error (setq isfun nil))))                (concat
549            (if isfun                 (buffer-substring (point) (progn (forward-word 1) (point)))
550                (progn                 "  = "))
551                  (setq tmp  
552                        (concat " " (buffer-substring               ((looking-at (sml-syms-re "case" "handle" "fn")) " => ")
553                                     (progn (forward-char 3)               ((looking-at (sml-syms-re "abstype" "datatype" "and")) "")
554                                            (skip-chars-forward "\t\n ") (point))               (t (error "Wow, now, there's a bug"))))))
555                                     (progn (forward-word 1) (point))) " "))  
556                  (setq case-or-handle-exp nil))       (unless (save-excursion (skip-chars-backward "\t ") (bolp)) (insert "\n"))
557              (setq tmp " ") (setq case-or-handle-exp nil))))))       (insert "| " text)
     (insert tmp)  
558      (sml-indent-line)      (sml-indent-line)
559      (beginning-of-line)      (beginning-of-line)
560         (skip-chars-forward "\t |")
561         (skip-syntax-forward "w")
562      (skip-chars-forward "\t ")      (skip-chars-forward "\t ")
563      (forward-char (1+ (length tmp)))       (when (= ?= (char-after)) (backward-char)))))
     (if case-or-handle-exp  
         (forward-char -4))))  
564    
565  (defun sml-electric-semi ()  (defun sml-electric-semi ()
566    "Inserts a \;.    "Inserts a \;.
# Line 746  Line 623 
623                    (setq indent 0))))                    (setq indent 0))))
624              (backward-delete-char-untabify (- start-column indent)))))))              (backward-delete-char-untabify (- start-column indent)))))))
625    
 (defconst sml-indent-starters-reg  
   (eval-when-compile  
     (concat "\\<"  
             (regexp-opt '("abstype" "and" "case" "datatype" "else"  
                           "fun" "if" "sharing" "in" "infix" "infixr"  
                           "let" "local" "nonfix" "of" "open" "raise" "sig"  
                           "struct" "then" "btype" "val"  
                           "while" "with" "withtype") t)  
             ;; removed "signature" "structure" "functor"  
             "\\>"))  
   "The indentation starters. The next line will be indented.")  
   
 (defconst sml-starters-reg  
   (eval-when-compile  
     (concat "\\<"  
             (regexp-opt '("abstraction" "abstype" "datatype" "exception" "fun"  
                            "functor" "local" "infix" "infixr" "sharing" "nonfix"  
                            "open" "signature" "structure" "type" "val"  
                            "withtype" "with") t)  
             "\\>"))  
   "The starters of new expressions.")  
   
 (defconst sml-end-starters-reg  
   (eval-when-compile  
     (concat "\\<" (regexp-opt '("let" "local" "sig" "struct" "with") t) "\\>"))  
   "Matching reg-expression for the \"end\" keyword.")  
   
 (defconst sml-starters-indent-after  
   (eval-when-compile  
     (concat "\\<" (regexp-opt '("let" "local" "struct" "in" "sig" "with") t)  
             "\\>"))  
   "Indent after these.")  
   
 (defconst sml-pipehead-regexp  
   (eval-when-compile  
     (concat "\\<" (regexp-opt '("fun" "fn" "and" "handle" "case" "datatype") t)  
             "\\>"))  
   "A `|' corresponds to one of these.")  
   
 (defconst sml-not-arg-regexp  
   (eval-when-compile  
     (concat "\\<" (regexp-opt '("in" "of" "end") t) "\\>"))  
   "Regexp matching lines that should never be indented as args.")  
   
   
626  (defun sml-find-comment-indent ()  (defun sml-find-comment-indent ()
627    (save-excursion    (save-excursion
628      (let ((depth 1))      (let ((depth 1))
# Line 806  Line 638 
638    
639  (defun sml-calculate-indentation ()  (defun sml-calculate-indentation ()
640    (save-excursion    (save-excursion
641      (let ((case-fold-search nil)      (beginning-of-line) (skip-chars-forward "\t ")
642            (indent 0))      (sml-with-ist
643         (let ((indent 0)
644               (sml-point (point)))
645        (or        (or
646         (and (beginning-of-line) nil)          ;;(and (bobp) 0)
        (and (bobp) 0)  
        (and (skip-chars-forward "\t ") nil)  
647    
648         ;; Indentation for comments alone on a line, matches the         ;; Indentation for comments alone on a line, matches the
649         ;; proper indentation of the next line.         ;; proper indentation of the next line.
650         (and (looking-at comment-start-skip) (sml-skip-spaces) nil)          (and (looking-at comment-start-skip) (sml-forward-spaces) nil)
651    
652         ;; continued comment         ;; continued comment
653         (and (looking-at "\\*") (setq indent (sml-find-comment-indent))         (and (looking-at "\\*") (setq indent (sml-find-comment-indent))
# Line 832  Line 664 
664                      (1+ (current-indentation))                      (1+ (current-indentation))
665                    0))))                    0))))
666    
        (and (looking-at "and\\>")  
             (if (sml-find-matching-starter sml-starters-reg)  
                 (current-column)  
               0))  
   
667         (and (looking-at "in\\>")          ; Match the beginning let/local         (and (looking-at "in\\>")          ; Match the beginning let/local
668              (sml-find-match-indent "in" "\\<in\\>" "\\<l\\(ocal\\|et\\)\\>"))               (sml-find-match-indent "\\<in\\>" "\\<l\\(ocal\\|et\\)\\>"))
669    
670         (and (looking-at "end\\>")         ; Match the beginning         (and (looking-at "end\\>")         ; Match the beginning
671              (sml-find-match-indent "end" "\\<end\\>" sml-end-starters-reg))               ;; FIXME: should match "in" if available.  Or maybe not
672                 (sml-find-match-indent "\\<end\\>" sml-begin-symbols-re))
673    
674         (and (looking-at "else\\>")        ; Match the if         (and (looking-at "else\\>")        ; Match the if
675              (progn              (progn
676                (sml-find-match-backward "else" "\\<else\\>" "\\<if\\>")                 (sml-find-match-backward "\\<else\\>" "\\<if\\>")
677                (let ((indent (current-column)))                 (sml-move-if (backward-word 1)
678                  (if (and sml-nested-if-indent                              (and sml-nested-if-indent
679                           (progn (sml-backward-sexp)                                   (looking-at "else[ \t]+if\\>")))
680                                  (looking-at "else[ \t]+if\\b")))                 (current-column)))
                     (current-column)  
                   indent))))  
681    
682         (and (looking-at "then\\>")        ; Match the if + extra indentation         (and (looking-at "then\\>")        ; Match the if + extra indentation
683              (sml-find-match-indent "then" "\\<then\\>" "\\<if\\>" t))               (sml-find-match-indent "\\<then\\>" "\\<if\\>" t))
684    
685         (and (looking-at "of\\>")         (and (looking-at "of\\>")
686              (progn              (progn
687                (sml-re-search-backward "\\<case\\>")                 (sml-find-match-backward "\\<of\\>" "\\<case\\>")
688                (+ (current-column) sml-indent-case-of)))                (+ (current-column) sml-indent-case-of)))
689    
690         (and (looking-at sml-starters-reg)          (and (looking-at sml-starters-re)
691              (let ((start (point)))               (let ((sym (sml-move-read (sml-move-if (not (sml-backward-arg))))))
692                (if (not (sml-backward-sexp))                 (if sym (sml-get-sym-indent sym)
693                    (if (and (looking-at sml-starters-indent-after)                   (sml-find-matching-starter sml-starters-re)
694                             (/= start (point)))                   (current-column))))
695                        (+ (if sml-type-of-indent  
696                               (current-column)          (and (looking-at "|") (sml-indent-pipe))
697                             (if (progn (beginning-of-line)  
698                                        (skip-chars-forward "\t ")          (sml-indent-arg)
699                                        (looking-at "|"))          (sml-indent-default))))))
700                                 (- (current-indentation) sml-pipe-indent)  
701                               (current-indentation)))  ;;        (let ((indent (current-column)))
702                           sml-indent-level)  ;;          ;;(skip-chars-forward "\t (")
703                      (beginning-of-line)  ;;          (cond
704                      (skip-chars-forward "\t ")  ;;           ;; a "let fun" or "let val"
705                      (if (and (looking-at sml-starters-indent-after)  ;;           ((looking-at "let \\(fun\\|val\\)\\>")
706                               (/= start (point)))  ;;            (+ (current-column) 4 sml-indent-level))
707                          (+ (if sml-type-of-indent  ;;           ;; Started val/fun/structure...
708                                 (current-column)  ;;           ;; Indent after "=>" pattern, but only if its not an fn _ =>
709                               (current-indentation))  ;;           ;; (890726)
710                             sml-indent-level)))  ;;           ((looking-at ".*=>")
711                  (goto-char start)  ;;            (if (looking-at ".*\\<fn\\>.*=>")
712                  (if (sml-find-matching-starter sml-starters-reg)  ;;                indent
713                      (current-column)  ;;              (+ indent sml-indent-case-arm)))
714                    0))))  ;;           ;; else keep the same indentation as previous line
715    ;;           (t indent)))))))))
716    
717    
718            ;;(and (setq indent (sml-get-indent)) nil)
719    
720            ;;(and (looking-at "=[^>]") (+ indent sml-indent-equal))
721            ;;(and (looking-at "fn\\>") (+ indent sml-indent-fn))
722            ;;       (and (looking-at "(") (+ indent sml-indent-paren))
723    
724         (and (looking-at "|")          ;;(and sml-paren-lookback    ; Look for open parenthesis ?
725              (when (sml-find-matching-starter sml-pipehead-regexp)          ;;    (max indent (sml-get-paren-indent)))
726            ;;indent)))))
727    
728    (defun sml-indent-pipe ()
729      (when (sml-find-matching-starter (concat "|\\|\\<of\\>\\|" sml-pipehead-re)
730                                       (sml-op-prec "|" 'back))
731        (if (looking-at "|")
732            (if (sml-bolp) (current-column) (sml-indent-pipe))
733                (cond                (cond
734                 ((looking-at "datatype")                 ((looking-at "datatype")
735                  (re-search-forward "=[ \n\t]*") nil t)          (re-search-forward "=")
736            (forward-char))
737                 ((looking-at "case\\>")                 ((looking-at "case\\>")
738                  (forward-word 1)        ;skip `case'          (sml-forward-sym)       ;skip `case'
739                  (sml-forward-sexps "of\\>")     ;skip the argument          (sml-find-match-forward "\\<case\\>" "\\<of\\>"))
                 (sml-forward-word)      ;skif the `of'  
                 (sml-skip-spaces))  
740                 (t                 (t
741                  (forward-word 1)          (forward-word 1)))
742                  (sml-skip-spaces)))        (sml-forward-spaces)
743                (+ sml-pipe-indent (current-column))))        (+ sml-pipe-indent (current-column)))))
744    
745    
746    (defun sml-indent-arg ()
747      (and (save-excursion (ignore-errors (sml-forward-arg)))
748           ;;(not (looking-at sml-not-arg-re))
749           ;; looks like a function or an argument
750           (sml-move-if (sml-backward-arg))
751           ;; an argument
752           (if (save-excursion (not (sml-backward-arg)))
753               ;; a first argument
754               (+ (current-column) sml-indent-args)
755             ;; not a first arg
756             (while (and (/= (current-column) (current-indentation))
757                         (sml-move-if (sml-backward-arg))))
758             (unless (save-excursion (sml-backward-arg))
759               ;; all earlier args are on the same line
760               (sml-forward-arg) (sml-forward-spaces))
761             (current-column))))
762    
763    (defun sml-re-assoc (al sym)
764      (when sym
765        (cdr (assoc* sym al
766                     :test (lambda (x y) (string-match y x))))))
767    (defun sml-get-indent (data n &optional strict)
768      (eval (if (listp data)
769                (nth n data)
770              (and (not strict) data))))
771    
772         (and (setq indent (sml-get-indent)) nil)  (defun sml-dangling-sym ()
773      (save-excursion
774        (and (not (sml-bolp))
775             (< (sml-point-after (end-of-line))
776                (sml-point-after (sml-forward-sym)
777                                 (sml-forward-spaces))))))
778    
779    (defun sml-get-sym-indent (sym &optional style)
780      "expects to be looking-at SYM."
781      (let ((indent-data (sml-re-assoc sml-indent-starters sym))
782            (delegate (eval (sml-re-assoc sml-delegate sym))))
783        (or (when indent-data
784              (if (or style (not delegate))
785                  ;; normal indentation
786                  (let ((indent (sml-get-indent indent-data (or style 0))))
787                    (when indent
788                      (+ (if (sml-dangling-sym)
789                             (sml-indent-default 'noindent)
790                           (current-column))
791                         indent)))
792                ;; delgate indentation to the parent
793                (sml-forward-sym) (sml-backward-sexp nil)
794                (let* ((parent-sym (save-excursion (sml-move-read (sml-forward-sym))))
795                       (parent-indent (sml-re-assoc sml-indent-starters parent-sym)))
796                  ;; check the special rules
797                  (sml-move-if (backward-word 1)
798                               (looking-at "\\<else[ \t]+if\\>"))
799                  (+ (if (sml-dangling-sym)
800                         (sml-indent-default 'noindent)
801                       (current-column))
802                     (or (sml-get-indent indent-data 1 'strict)
803                         (sml-get-indent parent-indent 1 'strict)
804                         (sml-get-indent indent-data 0)
805                         (sml-get-indent parent-indent 0))))))
806            ;; (save-excursion
807            ;;   (sml-forward-sym)
808            ;;   (when (> (sml-point-after (end-of-line))
809            ;;            (progn (sml-forward-spaces) (point)))
810            ;;     (current-column)))
811            )))
812    
813    (defun sml-indent-default (&optional noindent)
814      (let* ((sym-after (save-excursion (sml-move-read (sml-forward-sym))))
815             (prec-after (sml-op-prec sym-after 'back))
816             (_ (sml-backward-spaces))
817             (sym-before (sml-move-read (sml-backward-sym)))
818             (prec (or (sml-op-prec sym-before 'back) prec-after 100))
819             sexp)
820        (or (and sym-before (sml-get-sym-indent sym-before))
821            (progn
822              ;;(sml-forward-sym)
823              (while (and (not (sml-bolp))
824                          (sml-move-if (sml-backward-sexp (1- prec)))
825                          (not (sml-bolp)))
826                (while (sml-move-if (sml-backward-sexp prec))))
827              (or (and (not (sml-bolp))
828                       (= prec 65) (string-equal "=" sym-before) ;Yuck!!
829                       (save-excursion
830                         (sml-backward-spaces)
831                         (let* ((sym (sml-move-read (sml-backward-sym)))
832                                (sym-indent (sml-re-assoc sml-indent-starters sym)))
833                           (when sym-indent
834                             (if noindent
835                                 (current-column)
836                               (sml-get-sym-indent sym 1))))))
837                  (current-column))))))
838    
        (and (looking-at "=[^>]") (+ indent sml-indent-equal))  
        (and (looking-at "fn\\>") (+ indent sml-indent-fn))  
 ;;       (and (looking-at "(") (+ indent sml-indent-paren))  
839    
840         (and sml-paren-lookback    ; Look for open parenthesis ?  (defun sml-bolp ()
841              (max indent (sml-get-paren-indent)))    (save-excursion
842         indent))))      (skip-chars-backward " \t|") (bolp)))
843    
844  (defun sml-goto-first-subexp ()  ;; (defun sml-goto-first-subexp ()
845    (let ((initpoint (point)))  ;;   (let ((initpoint (point)))
     (skip-chars-forward " \t")  
     (let ((argp (and (looking-at "[\\-\\[({a-zA-Z0-9_'#~+*]\\|$")  
                      (not (looking-at (concat "[ \t]*" sml-not-arg-regexp))))))  
       (while (and argp (not (bobp)))  
         (let* ((endpoint (point))  
                (startpoint endpoint))  
           (setq argp  
                 (condition-case ()  
                     (progn (backward-sexp 1)  
                            (setq startpoint (point))  
                            (and (not (looking-at sml-keywords-regexp))  
                                 (progn (forward-sexp 1)  
                                        (sml-skip-spaces  
                                         (concat comment-start-skip "\\|[-~+*]"))  
                                        (>= (point) endpoint))))  
                   (error nil)))  
           (goto-char (if argp startpoint endpoint))))  
       (let ((res (point)))  
         (skip-syntax-backward " ") (skip-syntax-backward "^ ")  
         (if (looking-at "*\\|:[^=]\\|->\\|of\\>")  
             (goto-char initpoint)  
           (goto-char res)  
           (sml-skip-spaces))))))  
846    
847  (defun sml-get-indent ()  ;;     (let ((argp (and (looking-at "[[({a-zA-Z0-9_'#~]\\|$")
848    (save-excursion  ;;                   (not (looking-at (concat "[ \t]*" sml-not-arg-regexp))))))
849      (let ((case-fold-search nil)  ;;       (while (and argp (not (bobp)))
850            (endpoint (point))  ;;      (let* ((endpoint (point))
851            rover)  ;;             (startpoint endpoint))
852        (beginning-of-line)  ;;        (setq argp
853    ;;              (ignore-errors
854    ;;               (sml-backward-sexp t)
855    ;;               (setq startpoint (point))
856    ;;               (and (not (looking-at (concat "[[(]\\|" sml-keywords-regexp)))
857    ;;                    (progn (sml-forward-sexp)
858    ;;                           (sml-skip-spaces)
859    ;;                           (>= (point) endpoint)))))
860    ;;        (goto-char (if argp startpoint endpoint))))
861    ;;       (let ((res (point)))
862    ;;      (sml-backward-spaces) (skip-syntax-backward "^ ")
863    ;;      (if (looking-at "*\\|:[^=]\\|->\\|of\\>")
864    ;;          (goto-char initpoint)
865    ;;        (goto-char res)
866    ;;        (sml-skip-spaces))))))
867    
868        ;; let's try to see whether we are inside an expression  ;; maybe `|' should be set to word-syntax in our temp syntax table ?
869        (sml-goto-first-subexp)  (defun sml-current-indentation ()
       (setq rover (current-column))  
       (sml-skip-spaces)  
       (if (< (point) endpoint)  
           (progn                        ; we're not the first subexp  
             (sml-forward-sexp)  
             (if (and sml-indent-align-args  
                      (< (point) endpoint)  
                      (re-search-forward "[^ \n\t]" endpoint t))  
                 ;; we're not the second subexp  
                 (- (current-column) 1)  
               (+ rover sml-indent-args)))  
   
         (goto-char endpoint)  
         ;; we're not inside an expr  
         (skip-syntax-backward " ") (skip-chars-backward ";")  
         (if (looking-at ";") (sml-backward-sexp))  
         (cond  
          ((save-excursion (sml-backward-sexp) (looking-at "end\\>"))  
           (- (current-indentation) sml-indent-level))  
          (t  
           (while (/= (point)  
870                       (save-excursion                       (save-excursion
871                         (beginning-of-line)                         (beginning-of-line)
872                         (skip-chars-forward " \t|")                         (skip-chars-forward " \t|")
873                         (point)))      (current-column)))
             (sml-backward-sexp))  
           (when (looking-at "of") (forward-char 2))  
           (skip-chars-forward "\t |")  
           (let ((indent (current-column)))  
             (skip-chars-forward "\t (")  
             (cond  
              ;; a "let fun" or "let val"  
              ((looking-at "let \\(fun\\|val\\)\\>")  
               (+ (current-column) 4 sml-indent-level))  
              ;; Started val/fun/structure...  
              ((looking-at sml-indent-starters-reg)  
               (+ (current-column) sml-indent-level))  
              ;; Indent after "=>" pattern, but only if its not an fn _ =>  
              ;; (890726)  
              ((looking-at ".*=>")  
               (if (looking-at ".*\\<fn\\>.*=>")  
                   indent  
                 (+ indent sml-indent-case-arm)))  
              ;; else keep the same indentation as previous line  
              (t indent)))))))))  
874    
875  (defun sml-get-paren-indent ()  ;; (defun sml-get-indent ()
876    (save-excursion  ;;   (save-excursion
877      (let ((levelpar 0)                  ; Level of "()"  ;;     ;;(let ((endpoint (point)))
878            (levelcurl 0)                 ; Level of "{}"  
879            (levelsqr 0)                  ; Level of "[]"  ;;       ;; let's try to see whether we are inside an `f a1 a2 ..' expression
880            (backpoint (max (- (point) sml-paren-lookback) (point-min))))  ;;       ;;(sml-goto-first-subexp)
881        (catch 'loop  ;;       ;;(setq rover (current-column))
882          (while (and (/= levelpar 1) (/= levelsqr 1) (/= levelcurl 1))  ;;       ;;(sml-skip-spaces)
883            (if (re-search-backward "[][{}()]" backpoint t)  ;;       (cond
884                (if (not (sml-inside-comment-or-string-p))  ;; ;;        ((< (point) endpoint)
885                    (cond  ;; ;;   ;; we're not the first subexp
886                     ((looking-at "(") (setq levelpar (1+ levelpar)))  ;; ;;   (sml-forward-sexp)
887                     ((looking-at ")") (setq levelpar (1- levelpar)))  ;; ;;   (if (and sml-indent-align-args
888                     ((looking-at "\\[") (setq levelsqr (1+ levelsqr)))  ;; ;;            (progn (sml-skip-spaces) (< (point) endpoint)))
889                     ((looking-at "\\]") (setq levelsqr (1- levelsqr)))  ;; ;;       ;; we're not the second subexp
890                     ((looking-at "{") (setq levelcurl (1+ levelcurl)))  ;; ;;       (current-column)
891                     ((looking-at "}") (setq levelcurl (1- levelcurl)))))  ;; ;;     (+ rover sml-indent-args)))
892              (throw 'loop 0)))           ; Exit with value 0  
893          (if (save-excursion  ;;        ;; we're not inside an `f a1 a2 ..' expr
894                (forward-char 1)  ;;        ((progn ;;(goto-char endpoint)
895                (looking-at sml-indent-starters-reg))  ;;             (sml-backward-spaces)
896              (1+ (+ (current-column) sml-indent-level))  ;;             (/= (skip-chars-backward ";,") 0))
897            (1+ (current-column)))))))  ;;      (sml-backward-sexps (concat "[[(]\\'\\|" sml-user-begin-symbols-re))
898    ;;      (current-column))
 (defun sml-inside-comment-or-string-p ()  
   (let ((start (point)))  
     (if (save-excursion  
           (condition-case ()  
               (progn  
                 (search-backward "(*")  
                 (search-forward "*)")  
                 (forward-char -1)       ; A "*)" is not inside the comment  
                 (> (point) start))  
             (error nil)))  
         t  
       (let ((numb 0))  
         (save-excursion  
           (save-restriction  
             (narrow-to-region (progn (beginning-of-line) (point)) start)  
             (condition-case ()  
                 (while t  
                   (search-forward "\"")  
                   (setq numb (1+ numb)))  
               (error (if (and (not (zerop numb))  
                               (not (zerop (% numb 2))))  
                          t nil)))))))))  
   
 (defun sml-find-match-backward (unquoted-this this match)  
   (let ((case-fold-search nil)  
         (level 1)  
         (pattern (concat this "\\|" match)))  
     (while (not (zerop level))  
       (if (sml-re-search-backward pattern)  
           (setq level (cond  
                        ((looking-at this) (1+ level))  
                        ((looking-at match) (1- level))))  
         ;; The right match couldn't be found  
         (error (concat "Unbalanced: " unquoted-this))))))  
899    
900  (defun sml-find-match-indent (unquoted-this this match &optional indented)  ;;        (t
901    ;;      (while (/= (current-column) (current-indentation))
902    ;;        (sml-backward-sexp t))
903    ;;      (when (looking-at "\\<of\\>") (forward-word 1))
904    ;;      (skip-chars-forward "\t |")
905    ;;      (let ((indent (current-column)))
906    ;;        ;;(skip-chars-forward "\t (")
907    ;;        (cond
908    ;;         ;; a "let fun" or "let val"
909    ;;         ((looking-at "let \\(fun\\|val\\)\\>")
910    ;;          (+ (current-column) 4 sml-indent-level))
911    ;;         ;; Started val/fun/structure...
912    ;;         ((looking-at sml-indent-starters-reg)
913    ;;          (+ (current-column) sml-indent-level))
914    ;;         ;; Indent after "=>" pattern, but only if its not an fn _ =>
915    ;;         ;; (890726)
916    ;;         ((looking-at ".*=>")
917    ;;          (if (looking-at ".*\\<fn\\>.*=>")
918    ;;              indent
919    ;;            (+ indent sml-indent-case-arm)))
920    ;;         ;; else keep the same indentation as previous line
921    ;;         (t indent)))))))
922    
923    ;; (defun sml-get-paren-indent ()
924    ;;   (save-excursion
925    ;;     (condition-case ()
926    ;;      (progn
927    ;;        (up-list -1)
928    ;;        (if (save-excursion
929    ;;              (forward-char 1)
930    ;;              (looking-at sml-indent-starters-reg))
931    ;;            (1+ (+ (current-column) sml-indent-level))
932    ;;          (1+ (current-column))))
933    ;;       (error 0))))
934    
935    ;; (defun sml-inside-comment-or-string-p ()
936    ;;   (let ((start (point)))
937    ;;     (if (save-excursion
938    ;;           (condition-case ()
939    ;;               (progn
940    ;;                 (search-backward "(*")
941    ;;                 (search-forward "*)")
942    ;;                 (forward-char -1)       ; A "*)" is not inside the comment
943    ;;                 (> (point) start))
944    ;;             (error nil)))
945    ;;         t
946    ;;       (let ((numb 0))
947    ;;         (save-excursion
948    ;;           (save-restriction
949    ;;             (narrow-to-region (progn (beginning-of-line) (point)) start)
950    ;;             (condition-case ()
951    ;;                 (while t
952    ;;                   (search-forward "\"")
953    ;;                   (setq numb (1+ numb)))
954    ;;               (error (if (and (not (zerop numb))
955    ;;                               (not (zerop (% numb 2))))
956    ;;                          t nil)))))))))
957    
958    ;; (defun sml-find-match-backward (unquoted-this this match)
959    ;;   (let ((case-fold-search nil)
960    ;;      (level 1)
961    ;;      (pattern (concat this "\\|" match)))
962    ;;     (while (not (zerop level))
963    ;;       (if (sml-re-search-backward pattern)
964    ;;        (setq level (cond
965    ;;                     ((looking-at this) (1+ level))
966    ;;                     ((looking-at match) (1- level))))
967    ;;      ;; The right match couldn't be found
968    ;;      (error (concat "Unbalanced: " unquoted-this))))))
969    
970    (defun sml-find-match-indent (this match &optional indented)
971    (save-excursion    (save-excursion
972      (sml-find-match-backward unquoted-this this match)      (sml-find-match-backward this match)
973      (if (or sml-type-of-indent indented)      (if (or indented (not (sml-dangling-sym)))
974          (current-column)          (current-column)
975        (if (progn        (sml-indent-default 'noindent))))
             (beginning-of-line)  
             (skip-chars-forward "\t ")  
             (looking-at "|"))  
           (- (current-indentation) sml-pipe-indent)  
         (current-indentation)))))  
976    
977  (defun sml-find-matching-starter (regexp)  (defun sml-find-matching-starter (regexp &optional prec)
978    (sml-backward-sexp)    (sml-backward-sexp prec)
979    (while (not (or (looking-at regexp) (bobp)))    (while (not (or (looking-at regexp) (bobp)))
980      (sml-backward-sexp))      (sml-backward-sexp prec))
981    (not (bobp)))    (not (bobp)))
982    
983  (defun sml-re-search-backward (regexpr)  ;; (defun sml-re-search-backward (regexpr)
984    (let ((case-fold-search nil) (found t))  ;;   (let ((case-fold-search nil) (found t))
985      (if (re-search-backward regexpr nil t)  ;;     (if (re-search-backward regexpr nil t)
986          (progn  ;;         (progn
987            (condition-case ()  ;;           (condition-case ()
988                (while (sml-inside-comment-or-string-p)  ;;               (while (sml-inside-comment-or-string-p)
989                  (re-search-backward regexpr))  ;;                 (re-search-backward regexpr))
990              (error (setq found nil)))  ;;             (error (setq found nil)))
991            found)  ;;           found)
992        nil)))  ;;       nil)))
   
 (defun sml-up-list ()  
   (save-excursion  
     (condition-case ()  
         (progn  
           (up-list 1)  
           (point))  
       (error 0))))  
   
   
 (defun sml-forward-word ()  
   (sml-skip-spaces)  
   (forward-word 1))  
   
 ;; should skip comments, deal with "let", "local" and such expressions  
 (defun sml-forward-sexp ()  
   (condition-case ()  
       (forward-sexp 1)  
     (error (forward-char 1))))  
   
 ;; the terminators should be chosen more carefully:  
 ;; `let' isn't one while `=' may be  
 (defun sml-forward-sexps (&optional end)  
   (sml-skip-spaces)  
   (while (not (looking-at (or end (concat sml-keywords-regexp "\\|[])}|:;]"))))  
       (sml-forward-sexp)  
       (sml-skip-spaces)))  
   
 (defun sml-skip-spaces (&optional reg)  
   (let ((parse-sexp-ignore-comments nil))  
     (skip-syntax-forward " ")  
     (while (looking-at (or reg comment-start-skip))  
       (forward-sexp 1)  
       (skip-syntax-forward " "))))  
   
 ;; maybe we should do sml-backward-sexps and use it if we try to  
 ;; backward-sexp over a semi-colon ??  
 ;; return nil if it had to "move out"  
 (defun sml-backward-sexp ()  
   (condition-case ()  
       (progn  
         (backward-sexp 1)  
         (while (and (looking-at comment-start-skip) (not (bobp)))  
             (backward-sexp 1))  
         (if (looking-at "end\\>")  
             (progn  
               (sml-find-match-backward "end" "\\<end\\>" sml-end-starters-reg)  
               t)  
           (not (looking-at sml-end-starters-reg))))  
     (error (forward-char -1) nil)))  
993    
994  (defun sml-comment-indent ()  (defun sml-comment-indent ()
995    (if (looking-at "^(\\*")              ; Existing comment at beginning    (if (looking-at "^(\\*")              ; Existing comment at beginning
# Line 1364  Line 1224 
1224  (run-hooks 'sml-load-hook)  (run-hooks 'sml-load-hook)
1225    
1226  ;;; sml-mode.el has just finished.  ;;; sml-mode.el has just finished.
1227    (provide 'sml-mode)

Legend:
Removed from v.318  
changed lines
  Added in v.319

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0