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/trunk/sml-mode/sml-mode.el
ViewVC logotype

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

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

revision 299, Thu May 27 13:53:27 1999 UTC revision 300, Thu May 27 22:01:36 1999 UTC
# Line 109  Line 109 
109  (defvar sml-pipe-indent -2  (defvar sml-pipe-indent -2
110    "*Extra (usually negative) indentation for lines beginning with `|'.")    "*Extra (usually negative) indentation for lines beginning with `|'.")
111    
112  (defvar sml-indent-case-level 0  (defvar sml-indent-case-arm 0
113    "*Indentation of case arms.")    "*Indentation of case arms.")
114    
115    (defvar sml-indent-case-of 2
116      "*Indentation of an `of'¬†on its own line.")
117    
118  (defvar sml-indent-equal -2  (defvar sml-indent-equal -2
119    "*Extra (usually negative) indenting for lines beginning with `='.")    "*Extra (usually negative) indenting for lines beginning with `='.")
120    
121    (defvar sml-indent-fn -3
122      "*Extra (usually negative) indenting for lines beginning with `fn'.")
123    
124    ;;(defvar sml-indent-paren -1
125    ;;  "*Extra (usually negative) indenting for lines beginning with `('.")
126    
127  (defvar sml-indent-args 4  (defvar sml-indent-args 4
128    "*Indentation of args placed on a separate line.")    "*Indentation of args placed on a separate line.")
129    
# Line 251  Line 260 
260    (define-key map "\M-|"     'sml-electric-pipe)    (define-key map "\M-|"     'sml-electric-pipe)
261    (define-key map "\;"       'sml-electric-semi)    (define-key map "\;"       'sml-electric-semi)
262    (define-key map "\M-\t"    'sml-back-to-outer-indent)    (define-key map "\M-\t"    'sml-back-to-outer-indent)
   (define-key map "\C-j"     'newline-and-indent)  
   (define-key map "\177"     'backward-delete-char-untabify)  
263    (define-key map "\C-\M-\\" 'sml-indent-region)    (define-key map "\C-\M-\\" 'sml-indent-region)
264    (define-key map "\t"       'sml-indent-line) ; ...except this one    (define-key map "\t"       'sml-indent-line) ; ...except this one
265    ;; Process commands added to sml-mode-map -- these should autoload    ;; Process commands added to sml-mode-map -- these should autoload
# Line 287  Line 294 
294  ;; font-lock setup  ;; font-lock setup
295    
296  (defconst sml-keywords-regexp  (defconst sml-keywords-regexp
297    ;; (make-regexp '("abstraction" "abstype" "and" "andalso" "as" "case"    (eval-when-compile
298    ;;                "datatype" "else" "end" "eqtype" "exception" "do" "fn"      (concat
299    ;;                "fun" "functor" "handle" "if" "in" "include" "infix"       "\\<"
300    ;;                "infixr" "let" "local" "nonfix" "of" "op" "open" "orelse"       (regexp-opt '("abstraction" "abstype" "and" "andalso" "as" "before" "case"
301    ;;                "overload" "raise" "rec" "sharing" "sig" "signature"                     "datatype" "else" "end" "eqtype" "exception" "do" "fn"
302    ;;                "struct" "structure" "then" "type" "val" "where" "while"                     "fun" "functor" "handle" "if" "in" "include" "infix"
303    ;;                "with" "withtype") t)                     "infixr" "let" "local" "nonfix" "of" "op" "open" "orelse"
304    "\\<\\(a\\(bst\\(raction\\|ype\\)\\|nd\\(\\|also\\)\\|s\\)\\|case\\|d\\(atatype\\|o\\)\\|e\\(lse\\|nd\\|qtype\\|xception\\)\\|f\\(n\\|un\\(\\|ctor\\)\\)\\|handle\\|i\\([fn]\\|n\\(clude\\|fixr?\\)\\)\\|l\\(et\\|ocal\\)\\|nonfix\\|o\\([fp]\\|pen\\|relse\\|verload\\)\\|r\\(aise\\|ec\\)\\|s\\(haring\\|ig\\(\\|nature\\)\\|truct\\(\\|ure\\)\\)\\|t\\(hen\\|ype\\)\\|val\\|w\\(h\\(ere\\|ile\\)\\|ith\\(\\|type\\)\\)\\)\\>"                     "overload" "raise" "rec" "sharing" "sig" "signature"
305                       "struct" "structure" "then" "type" "val" "where" "while"
306                       "with" "withtype") t)
307         "\\>"))
308    "A regexp that matches any and all keywords of SML.")    "A regexp that matches any and all keywords of SML.")
309    
310  (defvar sml-font-lock-keywords  (defconst sml-font-lock-keywords
311    `((sml-font-comments-and-strings)    `(;;(sml-font-comments-and-strings)
312      ("\\<\\(fun\\|and\\)\\s-+\\(\\sw+\\)"      ("\\<\\(fun\\|and\\)\\s-+\\(\\(\\sw\\|\\s_\\)+\\)"
313       (1 font-lock-keyword-face)       (1 font-lock-keyword-face)
314       (2 font-lock-function-def-face))       (2 font-lock-function-def-face))
315      ("\\<\\(\\(data\\|abs\\|with\\|eq\\)?type\\)\\s-+\\('\\s-*\\sw+\\s-+\\)*\\(\\sw+\\)"      ("\\<\\(\\(data\\|abs\\|with\\|eq\\)?type\\)\\s-+\\('\\s-*\\(\\sw\\|\\s_\\)+\\s-+\\)*\\(\\(\\sw\\|\\s_\\)+\\)"
316       (1 font-lock-keyword-face)       (1 font-lock-keyword-face)
317       (4 font-lock-type-def-face))       (5 font-lock-type-def-face))
318      ("\\<\\(val\\)\\s-+\\(\\sw+\\>\\s-*\\)?\\(\\sw+\\)\\s-*="      ("\\<\\(val\\)\\s-+\\(\\(\\sw\\|\\s_\\)+\\>\\s-*\\)?\\(\\(\\sw\\|\\s_\\)+\\)\\s-*="
319       (1 font-lock-keyword-face)       (1 font-lock-keyword-face)
320       ;;(6 font-lock-variable-def-face nil t)       ;;(6 font-lock-variable-def-face nil t)
321       (3 font-lock-variable-def-face))       (4 font-lock-variable-def-face))
322      ("\\<\\(structure\\|functor\\|abstraction\\)\\s-+\\(\\sw+\\)"      ("\\<\\(structure\\|functor\\|abstraction\\)\\s-+\\(\\(\\sw\\|\\s_\\)+\\)"
323       (1 font-lock-keyword-face)       (1 font-lock-keyword-face)
324       (2 font-lock-module-def-face))       (2 font-lock-module-def-face))
325      ("\\<\\(signature\\)\\s-+\\(\\sw+\\)"      ("\\<\\(signature\\)\\s-+\\(\\(\\sw\\|\\s_\\)+\\)"
326       (1 font-lock-keyword-face)       (1 font-lock-keyword-face)
327       (2 font-lock-interface-def-face))       (2 font-lock-interface-def-face))
328    
# Line 320  Line 330 
330    "Regexps matching standard SML keywords.")    "Regexps matching standard SML keywords.")
331    
332  ;; default faces values  ;; default faces values
333  (defvar font-lock-function-def-face  (flet ((def-face (face def)
334    (if (facep 'font-lock-function-def-face)           "Define a face for font-lock."
335        'font-lock-function-name-face           (unless (boundp face)
336      'font-lock-function-name-face))             (set face (cond
337  (defvar font-lock-type-def-face                        ((facep face) face)
338    (if (facep 'font-lock-type-def-face)                        ((facep def) (copy-face def face))
339        'font-lock-type-def-face                        (t def))))))
340      'font-lock-type-face))    (def-face 'font-lock-function-def-face 'font-lock-function-name-face)
341  (defvar font-lock-module-def-face    (def-face 'font-lock-type-def-face 'font-lock-type-face)
342    (if (facep 'font-lock-module-def-face)    (def-face 'font-lock-module-def-face 'font-lock-function-name-face)
343        'font-lock-module-def-face    (def-face 'font-lock-interface-def-face 'font-lock-type-face)
344      'font-lock-function-name-face))    (def-face 'font-lock-variable-def-face 'font-lock-variable-name-face))
345  (defvar font-lock-interface-def-face  
346    (if (facep 'font-lock-interface-def-face)  ;; (setq sml-alt-syntax-table
347        'font-lock-interface-def-face  ;;       (let ((st (make-syntax-table)))
348      'font-lock-type-face))  ;;      (modify-syntax-entry ?l "(d" st)
349  (defvar font-lock-variable-def-face  ;;      (modify-syntax-entry ?d ")l" st)
350    (if (facep 'font-lock-variable-def-face)  ;;      (modify-syntax-entry ?\) ")(" st)
351        'font-lock-variable-def-face  ;;      st))
     'font-lock-variable-name-face))  
352    
353  (defvar sml-font-lock-defaults  (defun sml-get-depth-st ()
354    '(sml-font-lock-keywords t nil nil nil))    (save-excursion
355        (let* ((disp (if (eq (char-before) ?\)) (progn (backward-char) -1) nil))
356               (foo (backward-char))
357               (disp (if (eq (char-before) ?\() (progn (backward-char) 0) disp))
358               (pt (point)))
359          (when disp
360            (let* ((depth
361                    (save-match-data
362                      (if (re-search-backward "\\*)\\|(\\*" nil t)
363                          (+ (or (get-char-property (point) 'comment-depth) 0)
364                             (case (char-after) (?\( 1) (?* 0))
365                             disp)
366                        0)))
367                   (depth (if (> depth 0) depth)))
368              (put-text-property pt (1+ pt) 'comment-depth depth)
369              (when depth '(?.)))))))
370    
371    (defconst sml-font-lock-syntactic-keywords
372      '(;;("\\<\\(l\\)et\\>" (1 (?\( . ?d))) ;; sml-alt-syntax-table))
373        ;;("\\<en\\(d\\)\\>" (1 (?\) . ?l))) ;;sml-alt-syntax-table))
374        ("(?\\(\\*\\))?" (1 (sml-get-depth-st)))))
375    
376    (defconst sml-font-lock-defaults
377      '(sml-font-lock-keywords nil nil nil nil
378                               (font-lock-syntactic-keywords . sml-font-lock-syntactic-keywords)))
379    
380  ;; code to get comment fontification working in the face of recursive  ;; code to get comment fontification working in the face of recursive
381  ;; comments.  It's lots more work than it should be.    -- stefan  ;; comments.  It's lots more work than it should be.    -- stefan
382  (defvar sml-font-cache '((0 . normal))  ;; (defvar sml-font-cache '((0 . normal))
383    "List of (POSITION . STATE) pairs for an SML buffer.  ;;   "List of (POSITION . STATE) pairs for an SML buffer.
384  The STATE is either `normal', `comment', or `string'.  The POSITION is  ;; The STATE is either `normal', `comment', or `string'.  The POSITION is
385  immediately after the token that caused the state change.")  ;; immediately after the token that caused the state change.")
386  (make-variable-buffer-local 'sml-font-cache)  ;; (make-variable-buffer-local 'sml-font-cache)
387    
388  (defun sml-font-comments-and-strings (limit)  ;; (defun sml-font-comments-and-strings (limit)
389    "Fontify SML comments and strings up to LIMIT.  ;;   "Fontify SML comments and strings up to LIMIT.
390  Handles nested comments and SML's escapes for breaking a string over lines.  ;; Handles nested comments and SML's escapes for breaking a string over lines.
391  Uses sml-font-cache to maintain the fontification state over the buffer."  ;; Uses sml-font-cache to maintain the fontification state over the buffer."
392    (let ((beg (point))  ;;   (let ((beg (point))
393          last class)  ;;      last class)
394      (while (< beg limit)  ;;     (while (< beg limit)
395        (while (and sml-font-cache  ;;       (while (and sml-font-cache
396                    (> (caar sml-font-cache) beg))  ;;                (> (caar sml-font-cache) beg))
397          (pop sml-font-cache))  ;;      (pop sml-font-cache))
398        (setq last (caar sml-font-cache))  ;;       (setq last (caar sml-font-cache))
399        (setq class (cdar sml-font-cache))  ;;       (setq class (cdar sml-font-cache))
400        (goto-char last)  ;;       (goto-char last)
401        (cond  ;;       (cond
402         ((eq class 'normal)  ;;        ((eq class 'normal)
403          (cond  ;;      (cond
404           ((not (re-search-forward "\\((\\*\\)\\|\\(\"\\)" limit t))  ;;       ((not (re-search-forward "\\((\\*\\)\\|\\(\"\\)" limit t))
405            (goto-char limit))  ;;        (goto-char limit))
406           ((match-beginning 1)  ;;       ((match-beginning 1)
407            (push (cons (point) 'comment) sml-font-cache))  ;;        (push (cons (point) 'comment) sml-font-cache))
408           ((match-beginning 2)  ;;       ((match-beginning 2)
409            (push (cons (point) 'string) sml-font-cache))))  ;;        (push (cons (point) 'string) sml-font-cache))))
410         ((eq class 'comment)  ;;        ((eq class 'comment)
411          (cond  ;;      (cond
412           ((let ((nest 1))  ;;       ((let ((nest 1))
413              (while (and (> nest 0)  ;;          (while (and (> nest 0)
414                          (re-search-forward "\\((\\*\\)\\|\\(\\*)\\)" limit t))  ;;                      (re-search-forward "\\((\\*\\)\\|\\(\\*)\\)" limit t))
415                (cond  ;;            (cond
416                 ((match-beginning 1) (incf nest))  ;;             ((match-beginning 1) (incf nest))
417                 ((match-beginning 2) (decf nest))))  ;;             ((match-beginning 2) (decf nest))))
418              (> nest 0))  ;;          (> nest 0))
419            (goto-char limit))  ;;        (goto-char limit))
420           (t  ;;       (t
421            (push (cons (point) 'normal) sml-font-cache)))  ;;        (push (cons (point) 'normal) sml-font-cache)))
422          (put-text-property (- last 2) (point) 'face 'font-lock-comment-face))  ;;      (put-text-property (- last 2) (point) 'face 'font-lock-comment-face))
423         ((eq class 'string)  ;;        ((eq class 'string)
424          (while (and (re-search-forward  ;;      (while (and (re-search-forward
425                       "\\(\"\\)\\|\\(\\\\\\s-*\\\\\\)\\|\\(\\\\\"\\)" limit t)  ;;                   "\\(\"\\)\\|\\(\\\\\\s-*\\\\\\)\\|\\(\\\\\"\\)" limit t)
426                       (not (match-beginning 1))))  ;;                   (not (match-beginning 1))))
427          (cond  ;;      (cond
428           ((match-beginning 1)  ;;       ((match-beginning 1)
429            (push (cons (point) 'normal) sml-font-cache))  ;;        (push (cons (point) 'normal) sml-font-cache))
430           (t  ;;       (t
431            (goto-char limit)))  ;;        (goto-char limit)))
432          (put-text-property (- last 1) (point) 'face 'font-lock-string-face)))  ;;      (put-text-property (- last 1) (point) 'face 'font-lock-string-face)))
433        (setq beg (point)))))  ;;       (setq beg (point)))))
434    
435  ;;; 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
436    
# Line 473  Line 506 
506        (setq i (1+ i))))        (setq i (1+ i))))
507    
508    ;; Now we change the characters that are meaningful to us.    ;; Now we change the characters that are meaningful to us.
509      (modify-syntax-entry ?.       "_"     sml-mode-syntax-table)
510    (modify-syntax-entry ?\\      "\\"    sml-mode-syntax-table)    (modify-syntax-entry ?\\      "\\"    sml-mode-syntax-table)
511    (modify-syntax-entry ?\(      "()1"   sml-mode-syntax-table)    (modify-syntax-entry ?\(      "()1"   sml-mode-syntax-table)
512    (modify-syntax-entry ?\)      ")(4"   sml-mode-syntax-table)    (modify-syntax-entry ?\)      ")(4"   sml-mode-syntax-table)
# Line 486  Line 520 
520    (modify-syntax-entry ?\t      " "     sml-mode-syntax-table)    (modify-syntax-entry ?\t      " "     sml-mode-syntax-table)
521    (modify-syntax-entry ?\n      " "     sml-mode-syntax-table)    (modify-syntax-entry ?\n      " "     sml-mode-syntax-table)
522    (modify-syntax-entry ?\f      " "     sml-mode-syntax-table)    (modify-syntax-entry ?\f      " "     sml-mode-syntax-table)
523    (modify-syntax-entry ?\'      "w"     sml-mode-syntax-table)    (modify-syntax-entry ?\'      "_"     sml-mode-syntax-table)
524    (modify-syntax-entry ?\_      "w"     sml-mode-syntax-table))    (modify-syntax-entry ?\_      "_"     sml-mode-syntax-table))
525    
526  ;;;###Autoload  ;;;###Autoload
527  (defun sml-mode ()  (defun sml-mode ()
# Line 557  Line 591 
591    (set (make-local-variable 'comment-start-skip) "(\\*+[ \t]?")    (set (make-local-variable 'comment-start-skip) "(\\*+[ \t]?")
592    (set (make-local-variable 'comment-indent-function) 'sml-comment-indent)    (set (make-local-variable 'comment-indent-function) 'sml-comment-indent)
593    (set (make-local-variable 'font-lock-defaults) sml-font-lock-defaults)    (set (make-local-variable 'font-lock-defaults) sml-font-lock-defaults)
594      (set (make-local-variable 'parse-sexp-lookup-properties) t)
595      (set (make-local-variable 'parse-sexp-ignore-comments) t)
596    (setq sml-error-overlay (and sml-error-overlay (sml-make-overlay))))    (setq sml-error-overlay (and sml-error-overlay (sml-make-overlay))))
597    
598    ;; Adding these will fool the matching of parens -- because of a    ;; Adding these will fool the matching of parens -- because of a
# Line 588  Line 624 
624              (sml-move-overlay sml-error-overlay beg end))))))              (sml-move-overlay sml-error-overlay beg end))))))
625    
626  (defconst sml-pipe-matchers-reg  (defconst sml-pipe-matchers-reg
627    ;; (make-regexp '("case" "fn" "fun" "handle" "datatype" "abstype" "and") t)    (eval-when-compile
628    "\\<\\(a\\(bstype\\|nd\\)\\|case\\|datatype\\|f\\(n\\|un\\)\\|handle\\)\\>"      (concat
629         "\\<"
630         (regexp-opt '("case" "fn" "fun" "handle" "datatype" "abstype" "and") t)
631         "\\>"))
632    "The keywords a `|' can follow.")    "The keywords a `|' can follow.")
633    
634  (defun sml-electric-pipe ()  (defun sml-electric-pipe ()
# Line 708  Line 747 
747              (backward-delete-char-untabify (- start-column indent)))))))              (backward-delete-char-untabify (- start-column indent)))))))
748    
749  (defconst sml-indent-starters-reg  (defconst sml-indent-starters-reg
750    ;; (make-regexp '("abstraction" "abstype" "and" "case" "datatype" "else"    (eval-when-compile
751    ;;                "fun" "functor" "if" "sharing" "in" "infix" "infixr"      (concat "\\<"
752    ;;                "let" "local" "nonfix" "of" "open" "raise" "sig"              (regexp-opt '("abstype" "and" "case" "datatype" "else"
753    ;;                "signature" "struct" "structure" "then" "btype" "val"                            "fun" "if" "sharing" "in" "infix" "infixr"
754    ;;                "while" "with" "withtype") t)                            "let" "local" "nonfix" "of" "open" "raise" "sig"
755    "\\<\\(a\\(bst\\(raction\\|ype\\)\\|nd\\)\\|btype\\|case\\|datatype\\|else\\|fun\\(\\|ctor\\)\\|i\\([fn]\\|nfixr?\\)\\|l\\(et\\|ocal\\)\\|nonfix\\|o\\(f\\|pen\\)\\|raise\\|s\\(haring\\|ig\\(\\|nature\\)\\|truct\\(\\|ure\\)\\)\\|then\\|val\\|w\\(hile\\|ith\\(\\|type\\)\\)\\)\\>"                            "struct" "then" "btype" "val"
756                              "while" "with" "withtype") t)
757                ;; removed "signature" "structure" "functor"
758                "\\>"))
759    "The indentation starters. The next line will be indented.")    "The indentation starters. The next line will be indented.")
760    
761  (defconst sml-starters-reg  (defconst sml-starters-reg
762    ;; (make-regexp '("abstraction" "abstype" "datatype" "exception" "fun"    (eval-when-compile
763    ;;                "functor" "local" "infix" "infixr" "sharing" "nonfix"      (concat "\\<"
764    ;;                "open" "signature" "structure" "type" "val" "withtype"              (regexp-opt '("abstraction" "abstype" "datatype" "exception" "fun"
765    ;;                "with") t)                             "functor" "local" "infix" "infixr" "sharing" "nonfix"
766    "\\<\\(abst\\(raction\\|ype\\)\\|datatype\\|exception\\|fun\\(\\|ctor\\)\\|infixr?\\|local\\|nonfix\\|open\\|s\\(haring\\|ignature\\|tructure\\)\\|type\\|val\\|with\\(\\|type\\)\\)\\>"                             "open" "signature" "structure" "type" "val"
767                               "withtype" "with") t)
768                "\\>"))
769    "The starters of new expressions.")    "The starters of new expressions.")
770    
771  (defconst sml-end-starters-reg  (defconst sml-end-starters-reg
772    ;; (make-regexp '("let" "local" "sig" "struct" "with") t)    (eval-when-compile
773    "\\<\\(l\\(et\\|ocal\\)\\|s\\(ig\\|truct\\)\\|with\\)\\>"      (concat "\\<" (regexp-opt '("let" "local" "sig" "struct" "with") t) "\\>"))
774    "Matching reg-expression for the \"end\" keyword.")    "Matching reg-expression for the \"end\" keyword.")
775    
776  (defconst sml-starters-indent-after  (defconst sml-starters-indent-after
777    ;; (make-regexp '("let" "local" "struct" "in" "sig" "with") t)    (eval-when-compile
778    "\\<\\(in\\|l\\(et\\|ocal\\)\\|s\\(ig\\|truct\\)\\|with\\)\\>"      (concat "\\<" (regexp-opt '("let" "local" "struct" "in" "sig" "with") t)
779                "\\>"))
780    "Indent after these.")    "Indent after these.")
781    
782    (defconst sml-pipehead-regexp
783      (eval-when-compile
784        (concat "\\<" (regexp-opt '("fun" "fn" "and" "handle" "case" "datatype") t)
785                "\\>"))
786      "A `|' corresponds to one of these.")
787    
788    (defconst sml-not-arg-regexp
789      (eval-when-compile
790        (concat "\\<" (regexp-opt '("in" "of" "end") t) "\\>"))
791      "Regexp matching lines that should never be indented as args.")
792    
793    
794  (defun sml-find-comment-indent ()  (defun sml-find-comment-indent ()
795    (save-excursion    (save-excursion
796      (let ((depth 1))      (let ((depth 1))
# Line 741  Line 798 
798          (if (re-search-backward "(\\*\\|\\*)" nil t)          (if (re-search-backward "(\\*\\|\\*)" nil t)
799              (cond              (cond
800               ((looking-at "*)") (incf depth))               ((looking-at "*)") (incf depth))
801               ((looking-at "(\\*") (decf depth)))               ((looking-at comment-start-skip) (decf depth)))
802            (setq depth -1)))            (setq depth -1)))
803        (if (= depth 0)        (if (= depth 0)
804            (current-column)            (current-column)
# Line 750  Line 807 
807  (defun sml-calculate-indentation ()  (defun sml-calculate-indentation ()
808    (save-excursion    (save-excursion
809      (let ((case-fold-search nil)      (let ((case-fold-search nil)
810            (indent-col 0))            (indent 0))
811        (beginning-of-line)        (or
812        (if (bobp)                        ; Beginning of buffer         (and (beginning-of-line) nil)
813            0                             ; Indentation = 0         (and (bobp) 0)
814          (skip-chars-forward "\t ")         (and (skip-chars-forward "\t ") nil)
815          (cond  
816           ;; Indentation for comments alone on a line, matches the           ;; Indentation for comments alone on a line, matches the
817           ;; proper indentation of the next line. Search only for the         ;; proper indentation of the next line.
818           ;; next "*)", not for the matching.         (and (looking-at comment-start-skip) (sml-skip-spaces) nil)
819           ((and (looking-at "(\\*")  
                (condition-case () (progn (forward-sexp) t) (error nil)))  
           (end-of-line)  
           (skip-chars-forward "\n\t ")  
           ;; If we are at eob, just indent 0  
           (if (eobp) 0 (sml-calculate-indentation)))  
820           ;; continued comment           ;; continued comment
821           ((and (looking-at "\\*") (setq indent-col (sml-find-comment-indent)))         (and (looking-at "\\*") (setq indent (sml-find-comment-indent))
822            (1+ indent-col))            (1+ indent))
823    
824           ;; Continued string ? (Added 890113 lbn)           ;; Continued string ? (Added 890113 lbn)
825           ((looking-at "\\\\")         (and (looking-at "\\\\")
826            (save-excursion            (save-excursion
827              (if (save-excursion (previous-line 1)              (if (save-excursion (previous-line 1)
828                                  (beginning-of-line)                                  (beginning-of-line)
# Line 778  Line 831 
831              (if (re-search-backward "[^\\\\]\"" nil t)              (if (re-search-backward "[^\\\\]\"" nil t)
832                  (1+ (current-indentation))                  (1+ (current-indentation))
833                0))))                0))))
834           ;; Are we looking at a case expression ?  
835           ((looking-at "|.*=>")         (and (looking-at "and\\>")
           (sml-skip-block)  
           (sml-re-search-backward "=>")  
           ;; Dont get fooled by fn _ => in case statements (890726)  
           ;; Changed the regexp a bit, so fn has to be first on line,  
           ;; in order to let the loop continue (Used to be ".*\bfn....")  
           ;; (900430).  
           (let ((loop t))  
             (while (and loop (save-excursion  
                                (beginning-of-line)  
                                (looking-at "[^ \t]+\\bfn\\b.*=>")))  
               (setq loop (sml-re-search-backward "=>"))))  
           (beginning-of-line)  
           (skip-chars-forward "\t ")  
           (cond  
            ((looking-at "|") (current-indentation))  
            ((looking-at "of\\b")  
             (1+ (current-indentation)))  
            ((looking-at "fn\\b") (1+ (current-indentation)))  
            ((looking-at "handle\\b") (+ (current-indentation) 5))  
            (t (+ (current-indentation) sml-pipe-indent))))  
          ((looking-at "and\\b")  
836            (if (sml-find-matching-starter sml-starters-reg)            (if (sml-find-matching-starter sml-starters-reg)
837                (current-column)                (current-column)
838              0))              0))
839           ((looking-at "in\\b")          ; Match the beginning let/local  
840            (sml-find-match-indent "in" "\\bin\\b" "\\blocal\\b\\|\\blet\\b"))         (and (looking-at "in\\>")          ; Match the beginning let/local
841           ((looking-at "end\\b")         ; Match the beginning              (sml-find-match-indent "in" "\\<in\\>" "\\<l\\(ocal\\|et\\)\\>"))
842            (sml-find-match-indent "end" "\\bend\\b" sml-end-starters-reg))  
843  ;;         ((and sml-nested-if-indent (looking-at "else\\b"))         (and (looking-at "end\\>")         ; Match the beginning
844  ;;          (sml-re-search-backward "\\bif\\b\\|\\belse\\b")              (sml-find-match-indent "end" "\\<end\\>" sml-end-starters-reg))
845  ;;          (current-indentation))  
846           ((looking-at "else\\b")        ; Match the if         (and (looking-at "else\\>")        ; Match the if
847            (goto-char (sml-find-match-backward "else" "\\belse\\b" "\\bif\\b"))              (progn
848            (let ((tmp (current-column)))                (sml-find-match-backward "else" "\\<else\\>" "\\<if\\>")
849                  (let ((indent (current-column)))
850              (if (and sml-nested-if-indent              (if (and sml-nested-if-indent
851                       (progn (sml-backward-sexp)                       (progn (sml-backward-sexp)
852                              (looking-at "else[ \t]+if\\b")))                              (looking-at "else[ \t]+if\\b")))
853                  (current-column)                  (current-column)
854                tmp)))                    indent))))
855           ((looking-at "then\\b")        ; Match the if + extra indentation  
856            (sml-find-match-indent "then" "\\bthen\\b" "\\bif\\b" t))         (and (looking-at "then\\>")        ; Match the if + extra indentation
857           ((looking-at "of\\b")              (sml-find-match-indent "then" "\\<then\\>" "\\<if\\>" t))
858            (sml-re-search-backward "\\bcase\\b")  
859            (+ (current-column) 2))         (and (looking-at "of\\>")
860           ((looking-at sml-starters-reg)              (progn
861                  (sml-re-search-backward "\\<case\\>")
862                  (+ (current-column) sml-indent-case-of)))
863    
864           (and (looking-at sml-starters-reg)
865            (let ((start (point)))            (let ((start (point)))
866              (sml-backward-sexp)                (if (not (sml-backward-sexp))
867              (if (and (looking-at sml-starters-indent-after)              (if (and (looking-at sml-starters-indent-after)
868                       (/= start (point)))                       (/= start (point)))
869                  (+ (if sml-type-of-indent                  (+ (if sml-type-of-indent
# Line 844  Line 881 
881                    (+ (if sml-type-of-indent                    (+ (if sml-type-of-indent
882                           (current-column)                           (current-column)
883                         (current-indentation))                         (current-indentation))
884                       sml-indent-level)                             sml-indent-level)))
885                  (goto-char start)                  (goto-char start)
886                  (if (sml-find-matching-starter sml-starters-reg)                  (if (sml-find-matching-starter sml-starters-reg)
887                      (current-column)                      (current-column)
888                    0)))))                    0))))
889           (t  
890            (let ((indent (sml-get-indent)))         (and (looking-at "|")
891              (cond              (when (sml-find-matching-starter sml-pipehead-regexp)
              ((looking-at "|")  
               ;; Lets see if it is the follower of a function definition  
               (if (sml-find-matching-starter  
                    "\\bfun\\b\\|\\bfn\\b\\|\\band\\b\\|\\bhandle\\b")  
892                    (cond                    (cond
893                     ((looking-at "fun\\b") (- (current-column) sml-pipe-indent))                 ((looking-at "datatype")
894                     ((looking-at "fn\\b") (1+ (current-column)))                  (re-search-forward "=[ \n\t]*") nil t)
895                     ((looking-at "and\\b") (1+ (1+ (current-column))))                 ((looking-at "case\\>")
896                     ((looking-at "handle\\b") (+ (current-column) 5)))                  (forward-word 1)        ;skip `case'
897                  (+ indent sml-pipe-indent)))                  (sml-forward-sexps "of\\>")     ;skip the argument
898               ((looking-at "=[^>]")                  (sml-forward-word)      ;skif the `of'
899                (+ indent sml-indent-equal))                  (sml-skip-spaces))
900               (t               (t
901                (if sml-paren-lookback    ; Look for open parenthesis ?                  (forward-word 1)
902                    (max indent (sml-get-paren-indent))                  (sml-skip-spaces)))
903                  indent))))))))))                (+ sml-pipe-indent (current-column))))
904    
905           (and (setq indent (sml-get-indent)) nil)
906    
907           (and (looking-at "=[^>]") (+ indent sml-indent-equal))
908           (and (looking-at "fn\\>") (+ indent sml-indent-fn))
909    ;;       (and (looking-at "(") (+ indent sml-indent-paren))
910    
911           (and sml-paren-lookback    ; Look for open parenthesis ?
912                (max indent (sml-get-paren-indent)))
913           indent))))
914    
915  (defun sml-goto-first-subexp ()  (defun sml-goto-first-subexp ()
916    (let ((not-first (and (looking-at "[ \t]*[[({a-zA-Z0-9_'#]")    (let ((initpoint (point)))
917                          (not (looking-at (concat "[ \t]*" sml-keywords-regexp))))))      (skip-chars-forward " \t")
918      (while not-first      (let ((argp (and (looking-at "[\\-\\[({a-zA-Z0-9_'#~+*]\\|$")
919                         (not (looking-at (concat "[ \t]*" sml-not-arg-regexp))))))
920          (while (and argp (not (bobp)))
921        (let* ((endpoint (point))        (let* ((endpoint (point))
922               (first-p (condition-case ()                 (startpoint endpoint))
923              (setq argp
924                    (condition-case ()
925                            (progn (backward-sexp 1)                            (progn (backward-sexp 1)
926                                   (or (looking-at sml-keywords-regexp)                             (setq startpoint (point))
927                               (and (not (looking-at sml-keywords-regexp))
928                                       (progn (forward-sexp 1)                                       (progn (forward-sexp 1)
929                                              (re-search-forward "[^ \n\t]" endpoint t))))                                         (sml-skip-spaces
930                          (error t))))                                          (concat comment-start-skip "\\|[-~+*]"))
931          (goto-char endpoint)                                         (>= (point) endpoint))))
932          (if first-p                    (error nil)))
933              (progn            (goto-char (if argp startpoint endpoint))))
934                (condition-case ()        (let ((res (point)))
935                    (while (looking-at "[ \n\t]*(\\*")          (skip-syntax-backward " ") (skip-syntax-backward "^ ")
936                      (forward-sexp 1))          (if (looking-at "*\\|:[^=]\\|->\\|of\\>")
937                  (error nil))              (goto-char initpoint)
938                (setq not-first nil))            (goto-char res)
939            (backward-sexp 1))))))            (sml-skip-spaces))))))
940    
941  (defun sml-get-indent ()  (defun sml-get-indent ()
942    (save-excursion    (save-excursion
# Line 900  Line 948 
948        ;; let's try to see whether we are inside an expression        ;; let's try to see whether we are inside an expression
949        (sml-goto-first-subexp)        (sml-goto-first-subexp)
950        (setq rover (current-column))        (setq rover (current-column))
951        (if (and (< (point) endpoint)        (sml-skip-spaces)
952                 (re-search-forward "[^ \n\t]" endpoint t))        (if (< (point) endpoint)
953            (progn                        ; we're not the first subexp            (progn                        ; we're not the first subexp
954              (backward-sexp -1)              (sml-forward-sexp)
955              (if (and sml-indent-align-args              (if (and sml-indent-align-args
956                       (< (point) endpoint)                       (< (point) endpoint)
957                       (re-search-forward "[^ \n\t]" endpoint t))                       (re-search-forward "[^ \n\t]" endpoint t))
# Line 913  Line 961 
961    
962          (goto-char endpoint)          (goto-char endpoint)
963          ;; we're not inside an expr          ;; we're not inside an expr
964          (skip-chars-backward "\t\n; ")          (skip-syntax-backward " ") (skip-chars-backward ";")
965          (if (looking-at ";") (sml-backward-sexp))          (if (looking-at ";") (sml-backward-sexp))
966          (cond          (cond
967           ((save-excursion (sml-backward-sexp) (looking-at "end\\b"))           ((save-excursion (sml-backward-sexp) (looking-at "end\\>"))
968            (- (current-indentation) sml-indent-level))            (- (current-indentation) sml-indent-level))
969           (t           (t
970            (while (/= (current-column) (current-indentation))            (while (/= (point)
971                         (save-excursion
972                           (beginning-of-line)
973                           (skip-chars-forward " \t|")
974                           (point)))
975              (sml-backward-sexp))              (sml-backward-sexp))
976            (when (looking-at "of") (forward-char 2))            (when (looking-at "of") (forward-char 2))
977            (skip-chars-forward "\t |")            (skip-chars-forward "\t |")
# Line 935  Line 987 
987               ;; Indent after "=>" pattern, but only if its not an fn _ =>               ;; Indent after "=>" pattern, but only if its not an fn _ =>
988               ;; (890726)               ;; (890726)
989               ((looking-at ".*=>")               ((looking-at ".*=>")
990                (if (looking-at ".*\\bfn\\b.*=>")                (if (looking-at ".*\\<fn\\>.*=>")
991                    indent                    indent
992                  (+ indent sml-indent-case-level)))                  (+ indent sml-indent-case-arm)))
993               ;; else keep the same indentation as previous line               ;; else keep the same indentation as previous line
994               (t indent)))))))))               (t indent)))))))))
995    
# Line 988  Line 1040 
1040                                (not (zerop (% numb 2))))                                (not (zerop (% numb 2))))
1041                           t nil)))))))))                           t nil)))))))))
1042    
1043  (defun sml-skip-block ()  (defun sml-find-match-backward (unquoted-this this match)
   (let ((case-fold-search nil))  
     (sml-backward-sexp)  
     (if (looking-at "end\\b")  
         (progn  
           (goto-char (sml-find-match-backward "end" "\\bend\\b"  
                                               sml-end-starters-reg))  
           (skip-chars-backward "\n\t "))  
       ;; Here we will need to skip backward past if-then-else  
       ;; and case-of expression. Please - tell me how !!  
       )))  
   
 (defun sml-find-match-backward (unquoted-this this match &optional start)  
   (save-excursion  
1044      (let ((case-fold-search nil)      (let ((case-fold-search nil)
1045            (level 1)            (level 1)
1046            (pattern (concat this "\\|" match)))            (pattern (concat this "\\|" match)))
       (if start (goto-char start))  
1047        (while (not (zerop level))        (while (not (zerop level))
1048          (if (sml-re-search-backward pattern)          (if (sml-re-search-backward pattern)
1049              (setq level (cond              (setq level (cond
1050                           ((looking-at this) (1+ level))                           ((looking-at this) (1+ level))
1051                           ((looking-at match) (1- level))))                           ((looking-at match) (1- level))))
1052            ;; The right match couldn't be found            ;; The right match couldn't be found
1053            (error (concat "Unbalanced: " unquoted-this))))          (error (concat "Unbalanced: " unquoted-this))))))
       (point))))  
1054    
1055  (defun sml-find-match-indent (unquoted-this this match &optional indented)  (defun sml-find-match-indent (unquoted-this this match &optional indented)
1056    (save-excursion    (save-excursion
1057      (goto-char (sml-find-match-backward unquoted-this this match))      (sml-find-match-backward unquoted-this this match)
1058      (if (or sml-type-of-indent indented)      (if (or sml-type-of-indent indented)
1059          (current-column)          (current-column)
1060        (if (progn        (if (progn
# Line 1028  Line 1065 
1065          (current-indentation)))))          (current-indentation)))))
1066    
1067  (defun sml-find-matching-starter (regexp)  (defun sml-find-matching-starter (regexp)
1068    (let ((case-fold-search nil)    (sml-backward-sexp)
1069          (start-let-point (sml-point-inside-let-etc))    (while (not (or (looking-at regexp) (bobp)))
1070          (start-up-list (sml-up-list))      (sml-backward-sexp))
1071          (found t))    (not (bobp)))
     (if (sml-re-search-backward regexp)  
         (progn  
           (condition-case ()  
               (while (or (/= start-up-list (sml-up-list))  
                          (/= start-let-point (sml-point-inside-let-etc)))  
                 (re-search-backward regexp))  
             (error (setq found nil)))  
           found)  
       nil)))  
   
 (defun sml-point-inside-let-etc ()  
   (let ((case-fold-search nil) (last nil) (loop t) (found t) (start (point)))  
     (save-excursion  
       (while loop  
         (condition-case ()  
             (progn  
               (re-search-forward "\\bend\\b")  
               (while (sml-inside-comment-or-string-p)  
                 (re-search-forward "\\bend\\b"))  
               (forward-char -3)  
               (setq last (sml-find-match-backward "end" "\\bend\\b"  
                                                   sml-end-starters-reg last))  
               (if (< last start)  
                   (setq loop nil)  
                 (forward-char 3)))  
           (error (progn (setq found nil) (setq loop nil)))))  
       (if found  
           last  
         0))))  
1072    
1073  (defun sml-re-search-backward (regexpr)  (defun sml-re-search-backward (regexpr)
1074    (let ((case-fold-search nil) (found t))    (let ((case-fold-search nil) (found t))
# Line 1081  Line 1089 
1089            (point))            (point))
1090        (error 0))))        (error 0))))
1091    
1092    
1093    (defun sml-forward-word ()
1094      (sml-skip-spaces)
1095      (forward-word 1))
1096    
1097    ;; should skip comments, deal with "let", "local" and such expressions
1098    (defun sml-forward-sexp ()
1099      (condition-case ()
1100          (forward-sexp 1)
1101        (error (forward-char 1))))
1102    
1103    ;; the terminators should be chosen more carefully:
1104    ;; `let' isn't one while `=' may be
1105    (defun sml-forward-sexps (&optional end)
1106      (sml-skip-spaces)
1107      (while (not (looking-at (or end (concat sml-keywords-regexp "\\|[])}|:;]"))))
1108          (sml-forward-sexp)
1109          (sml-skip-spaces)))
1110    
1111    (defun sml-skip-spaces (&optional reg)
1112      (let ((parse-sexp-ignore-comments nil))
1113        (skip-syntax-forward " ")
1114        (while (looking-at (or reg comment-start-skip))
1115          (forward-sexp 1)
1116          (skip-syntax-forward " "))))
1117    
1118    ;; maybe we should do sml-backward-sexps and use it if we try to
1119    ;; backward-sexp over a semi-colon ??
1120    ;; return nil if it had to "move out"
1121  (defun sml-backward-sexp ()  (defun sml-backward-sexp ()
1122    (condition-case ()    (condition-case ()
1123        (progn        (progn
         (let ((start (point)))  
1124            (backward-sexp 1)            (backward-sexp 1)
1125            (while (and (/= start (point)) (looking-at "(\\*"))          (while (and (looking-at comment-start-skip) (not (bobp)))
1126              (setq start (point))              (backward-sexp 1))
1127              (backward-sexp 1))))          (if (looking-at "end\\>")
1128      (error (forward-char -1))))              (progn
1129                  (sml-find-match-backward "end" "\\<end\\>" sml-end-starters-reg)
1130                  t)
1131              (not (looking-at sml-end-starters-reg))))
1132        (error (forward-char -1) nil)))
1133    
1134  (defun sml-comment-indent ()  (defun sml-comment-indent ()
1135    (if (looking-at "^(\\*")              ; Existing comment at beginning    (if (looking-at "^(\\*")              ; Existing comment at beginning

Legend:
Removed from v.299  
changed lines
  Added in v.300

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