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 38, Fri Mar 13 20:31:45 1998 UTC revision 39, Sat Mar 14 04:41:37 1998 UTC
# Line 93  Line 93 
93  ;;; VERSION STRING  ;;; VERSION STRING
94    
95  (defconst sml-mode-version-string  (defconst sml-mode-version-string
96    "sml-mode, version 3.3(beta)")    "sml-mode, version 3.3")
97    
98  (require 'cl)  (require 'cl)
99  (provide 'sml-mode)  (provide 'sml-mode)
# Line 104  Line 104 
104    "*Indentation of blocks in ML (see also `sml-structure-indent').")    "*Indentation of blocks in ML (see also `sml-structure-indent').")
105    
106  (defvar sml-structure-indent 4          ; Not currently an option.  (defvar sml-structure-indent 4          ; Not currently an option.
107    "Indentation of signature/structure/functor declarations.")    "*Indentation of signature/structure/functor declarations.")
108    
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
113      "*Indentation of case arms.")
114    
115    (defvar sml-indent-equal -2
116      "*Extra (usually negative) indenting for lines beginning with `='.")
117    
118    (defvar sml-indent-args 4
119      "*Indentation of args placed on a separate line.")
120    
121    (defvar sml-indent-align-args t
122      "*Whether the arguments should be aligned.")
123    
124  (defvar sml-case-indent nil  (defvar sml-case-indent nil
125    "*How to indent case-of expressions.    "*How to indent case-of expressions.
# Line 274  Line 286 
286    
287  ;; font-lock setup  ;; font-lock setup
288    
289    (defconst sml-keywords-regexp
290      ;; (make-regexp '("abstraction" "abstype" "and" "andalso" "as" "case"
291      ;;                "datatype" "else" "end" "eqtype" "exception" "do" "fn"
292      ;;                "fun" "functor" "handle" "if" "in" "include" "infix"
293      ;;                "infixr" "let" "local" "nonfix" "of" "op" "open" "orelse"
294      ;;                "overload" "raise" "rec" "sharing" "sig" "signature"
295      ;;                "struct" "structure" "then" "type" "val" "where" "while"
296      ;;                "with" "withtype") t)
297      "\\<\\(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\\)\\)\\)\\>"
298      "A regexp that matches any and all keywords of SML.")
299    
300  (defvar sml-font-lock-keywords  (defvar sml-font-lock-keywords
301    '((sml-font-comments-and-strings)    `((sml-font-comments-and-strings)
302      ("\\<\\(fun\\|and\\)\\s-+\\(\\sw+\\)"      ("\\<\\(fun\\|and\\)\\s-+\\(\\sw+\\)"
303       (1 font-lock-keyword-face)       (1 font-lock-keyword-face)
304       (2 font-lock-function-def-face))       (2 font-lock-function-def-face))
# Line 293  Line 316 
316       (1 font-lock-keyword-face)       (1 font-lock-keyword-face)
317       (2 font-lock-interface-def-face))       (2 font-lock-interface-def-face))
318    
319      ;; Generated with Simon Marshall's make-regexp:      (,sml-keywords-regexp . font-lock-keyword-face))
     ;; (make-regexp  
     ;;  '("abstype" "and" "andalso" "as" "case" "datatype"  
     ;;    "else" "end" "eqtype" "exception" "do" "fn" "fun" "functor"  
     ;;    "handle" "if" "in" "include" "infix" "infixr" "let" "local"  
     ;;    "nonfix" "of" "op" "open" "orelse" "overload" "raise" "rec"  
     ;;    "sharing" "sig" "signature" "struct" "structure" "then" "type"  
     ;;    "val" "where" "while" "with" "withtype") t)  
     ("\\<\\(a\\(bstype\\|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\\)\\)\\)\\>"  
      . font-lock-keyword-face))  
320    "Regexps matching standard SML keywords.")    "Regexps matching standard SML keywords.")
321    
322  ;; default faces values  ;; default faces values
# Line 579  Line 588 
588              (sml-move-overlay sml-error-overlay beg end))))))              (sml-move-overlay sml-error-overlay beg end))))))
589    
590  (defconst sml-pipe-matchers-reg  (defconst sml-pipe-matchers-reg
591    "\\bcase\\b\\|\\bfn\\b\\|\\bfun\\b\\|\\bhandle\\b\    ;; (make-regexp '("case" "fn" "fun" "handle" "datatype" "abstype" "and") t)
592  \\|\\bdatatype\\b\\|\\babstype\\b\\|\\band\\b"    "\\<\\(a\\(bstype\\|nd\\)\\|case\\|datatype\\|f\\(n\\|un\\)\\|handle\\)\\>"
593    "The keywords a `|' can follow.")    "The keywords a `|' can follow.")
594    
595  (defun sml-electric-pipe ()  (defun sml-electric-pipe ()
# Line 699  Line 708 
708              (backward-delete-char-untabify (- start-column indent)))))))              (backward-delete-char-untabify (- start-column indent)))))))
709    
710  (defconst sml-indent-starters-reg  (defconst sml-indent-starters-reg
711    "abstraction\\b\\|abstype\\b\\|and\\b\\|case\\b\\|datatype\\b\    ;; (make-regexp '("abstraction" "abstype" "and" "case" "datatype" "else"
712  \\|else\\b\\|fun\\b\\|functor\\b\\|if\\b\\|sharing\\b\    ;;                "fun" "functor" "if" "sharing" "in" "infix" "infixr"
713  \\|in\\b\\|infix\\b\\|infixr\\b\\|let\\b\\|local\\b\    ;;                "let" "local" "nonfix" "of" "open" "raise" "sig"
714  \\|nonfix\\b\\|of\\b\\|open\\b\\|raise\\b\\|sig\\b\\|signature\\b\    ;;                "signature" "struct" "structure" "then" "btype" "val"
715  \\|struct\\b\\|structure\\b\\|then\\b\\|\\btype\\b\\|val\\b\    ;;                "while" "with" "withtype") t)
716  \\|while\\b\\|with\\b\\|withtype\\b"    "\\<\\(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\\)\\)\\)\\>"
717    "The indentation starters. The next line will be indented.")    "The indentation starters. The next line will be indented.")
718    
719  (defconst sml-starters-reg  (defconst sml-starters-reg
720    "\\babstraction\\b\\|\\babstype\\b\\|\\bdatatype\\b\    ;; (make-regexp '("abstraction" "abstype" "datatype" "exception" "fun"
721  \\|\\bexception\\b\\|\\bfun\\b\\|\\bfunctor\\b\\|\\blocal\\b\    ;;                "functor" "local" "infix" "infixr" "sharing" "nonfix"
722  \\|\\binfix\\b\\|\\binfixr\\b\\|\\bsharing\\b\    ;;                "open" "signature" "structure" "type" "val" "withtype"
723  \\|\\bnonfix\\b\\|\\bopen\\b\\|\\bsignature\\b\\|\\bstructure\\b\    ;;                "with") t)
724  \\|\\btype\\b\\|\\bval\\b\\|\\bwithtype\\b\\|\\bwith\\b"    "\\<\\(abst\\(raction\\|ype\\)\\|datatype\\|exception\\|fun\\(\\|ctor\\)\\|infixr?\\|local\\|nonfix\\|open\\|s\\(haring\\|ignature\\|tructure\\)\\|type\\|val\\|with\\(\\|type\\)\\)\\>"
725    "The starters of new expressions.")    "The starters of new expressions.")
726    
727  (defconst sml-end-starters-reg  (defconst sml-end-starters-reg
728    "\\blet\\b\\|\\blocal\\b\\|\\bsig\\b\\|\\bstruct\\b\\|\\bwith\\b"    ;; (make-regexp '("let" "local" "sig" "struct" "with") t)
729      "\\<\\(l\\(et\\|ocal\\)\\|s\\(ig\\|truct\\)\\|with\\)\\>"
730    "Matching reg-expression for the \"end\" keyword.")    "Matching reg-expression for the \"end\" keyword.")
731    
732  (defconst sml-starters-indent-after  (defconst sml-starters-indent-after
733    "let\\b\\|local\\b\\|struct\\b\\|in\\b\\|sig\\b\\|with\\b"    ;; (make-regexp '("let" "local" "struct" "in" "sig" "with") t)
734      "\\<\\(in\\|l\\(et\\|ocal\\)\\|s\\(ig\\|truct\\)\\|with\\)\\>"
735    "Indent after these.")    "Indent after these.")
736    
737    (defun sml-find-comment-indent ()
738      (save-excursion
739        (let ((depth 1))
740          (while (> depth 0)
741            (if (re-search-backward "(\\*\\|\\*)" nil t)
742                (cond
743                 ((looking-at "*)") (incf depth))
744                 ((looking-at "(\\*") (decf depth)))
745              (setq depth -1)))
746          (if (= depth 0)
747              (current-column)
748            nil))))
749    
750  (defun sml-calculate-indentation ()  (defun sml-calculate-indentation ()
751    (save-excursion    (save-excursion
752      (let ((case-fold-search nil))      (let ((case-fold-search nil)
753              (indent-col 0))
754        (beginning-of-line)        (beginning-of-line)
755        (if (bobp)                        ; Beginning of buffer        (if (bobp)                        ; Beginning of buffer
756            0                             ; Indentation = 0            0                             ; Indentation = 0
# Line 734  Line 759 
759           ;; Indentation for comments alone on a line, matches the           ;; Indentation for comments alone on a line, matches the
760           ;; proper indentation of the next line. Search only for the           ;; proper indentation of the next line. Search only for the
761           ;; next "*)", not for the matching.           ;; next "*)", not for the matching.
762           ((looking-at "(\\*")           ((and (looking-at "(\\*")
763            (if (not (search-forward "*)" nil t))                 (condition-case () (progn (forward-sexp) t) (error nil)))
               (error "Comment not ended."))  
764            (end-of-line)            (end-of-line)
765            (skip-chars-forward "\n\t ")            (skip-chars-forward "\n\t ")
766            ;; If we are at eob, just indent 0            ;; If we are at eob, just indent 0
767            (if (eobp) 0 (sml-calculate-indentation)))            (if (eobp) 0 (sml-calculate-indentation)))
768             ;; continued comment
769             ((and (looking-at "\\*") (setq indent-col (sml-find-comment-indent)))
770              (1+ indent-col))
771           ;; Continued string ? (Added 890113 lbn)           ;; Continued string ? (Added 890113 lbn)
772           ((looking-at "\\\\")           ((looking-at "\\\\")
773            (save-excursion            (save-excursion
# Line 781  Line 808 
808            (sml-find-match-indent "in" "\\bin\\b" "\\blocal\\b\\|\\blet\\b"))            (sml-find-match-indent "in" "\\bin\\b" "\\blocal\\b\\|\\blet\\b"))
809           ((looking-at "end\\b")         ; Match the beginning           ((looking-at "end\\b")         ; Match the beginning
810            (sml-find-match-indent "end" "\\bend\\b" sml-end-starters-reg))            (sml-find-match-indent "end" "\\bend\\b" sml-end-starters-reg))
811           ((and sml-nested-if-indent (looking-at "else\\b"))  ;;         ((and sml-nested-if-indent (looking-at "else\\b"))
812            (sml-re-search-backward "\\bif\\b\\|\\belse\\b")  ;;          (sml-re-search-backward "\\bif\\b\\|\\belse\\b")
813            (current-indentation))  ;;          (current-indentation))
814           ((looking-at "else\\b")        ; Match the if           ((looking-at "else\\b")        ; Match the if
815            (sml-find-match-indent "else" "\\belse\\b" "\\bif\\b" t))            (goto-char (sml-find-match-backward "else" "\\belse\\b" "\\bif\\b"))
816              (let ((tmp (current-column)))
817                (if (and sml-nested-if-indent
818                         (progn (sml-backward-sexp)
819                                (looking-at "else[ \t]+if\\b")))
820                    (current-column)
821                  tmp)))
822           ((looking-at "then\\b")        ; Match the if + extra indentation           ((looking-at "then\\b")        ; Match the if + extra indentation
823            (+ (sml-find-match-indent "then" "\\bthen\\b" "\\bif\\b" t)            (sml-find-match-indent "then" "\\bthen\\b" "\\bif\\b" t))
              (if sml-type-of-indent sml-indent-level 0)))  
824           ((looking-at "of\\b")           ((looking-at "of\\b")
825            (sml-re-search-backward "\\bcase\\b")            (sml-re-search-backward "\\bcase\\b")
826            (+ (current-column) 2))            (+ (current-column) 2))
# Line 830  Line 862 
862                     ((looking-at "and\\b") (1+ (1+ (current-column))))                     ((looking-at "and\\b") (1+ (1+ (current-column))))
863                     ((looking-at "handle\\b") (+ (current-column) 5)))                     ((looking-at "handle\\b") (+ (current-column) 5)))
864                  (+ indent sml-pipe-indent)))                  (+ indent sml-pipe-indent)))
865                 ((looking-at "=[^>]")
866                  (+ indent sml-indent-equal))
867               (t               (t
868                (if sml-paren-lookback    ; Look for open parenthesis ?                (if sml-paren-lookback    ; Look for open parenthesis ?
869                    (max indent (sml-get-paren-indent))                    (max indent (sml-get-paren-indent))
870                  indent))))))))))                  indent))))))))))
871    
872    (defun sml-goto-first-subexp ()
873      (let ((not-first (and (looking-at "[ \t]*[[({a-zA-Z0-9_'#]")
874                            (not (looking-at (concat "[ \t]*" sml-keywords-regexp))))))
875        (while not-first
876          (let* ((endpoint (point))
877                 (first-p (condition-case ()
878                              (progn (backward-sexp 1)
879                                     (or (looking-at sml-keywords-regexp)
880                                         (progn (forward-sexp 1)
881                                                (re-search-forward "[^ \n\t]" endpoint t))))
882                            (error t))))
883            (goto-char endpoint)
884            (if first-p
885                (progn
886                  (condition-case ()
887                      (while (looking-at "[ \n\t]*(\\*")
888                        (forward-sexp 1))
889                    (error nil))
890                  (setq not-first nil))
891              (backward-sexp 1))))))
892    
893  (defun sml-get-indent ()  (defun sml-get-indent ()
894    (save-excursion    (save-excursion
895      (let ((case-fold-search nil))      (let ((case-fold-search nil)
896              (endpoint (point))
897              rover)
898        (beginning-of-line)        (beginning-of-line)
899    
900          ;; let's try to see whether we are inside an expression
901          (sml-goto-first-subexp)
902          (setq rover (current-column))
903          (if (and (< (point) endpoint)
904                   (re-search-forward "[^ \n\t]" endpoint t))
905              (progn                        ; we're not the first subexp
906                (backward-sexp -1)
907                (if (and sml-indent-align-args
908                         (< (point) endpoint)
909                         (re-search-forward "[^ \n\t]" endpoint t))
910                    ;; we're not the second subexp
911                    (- (current-column) 1)
912                  (+ rover sml-indent-args)))
913    
914            (goto-char endpoint)
915            ;; we're not inside an expr
916        (skip-chars-backward "\t\n; ")        (skip-chars-backward "\t\n; ")
917        (if (looking-at ";") (sml-backward-sexp))        (if (looking-at ";") (sml-backward-sexp))
918        (cond        (cond
# Line 847  Line 921 
921         (t         (t
922          (while (/= (current-column) (current-indentation))          (while (/= (current-column) (current-indentation))
923            (sml-backward-sexp))            (sml-backward-sexp))
924              (when (looking-at "of") (forward-char 2))
925          (skip-chars-forward "\t |")          (skip-chars-forward "\t |")
926          (let ((indent (current-column)))          (let ((indent (current-column)))
927            (skip-chars-forward "\t (")            (skip-chars-forward "\t (")
928            (cond            (cond
929             ;; a "let fun" or "let val"             ;; a "let fun" or "let val"
930             ((looking-at "let \\(fun\\|val\\)\\b")               ((looking-at "let \\(fun\\|val\\)\\>")
931              (+ (current-column) 4 sml-indent-level))              (+ (current-column) 4 sml-indent-level))
932             ;; Started val/fun/structure...             ;; Started val/fun/structure...
933             ((looking-at sml-indent-starters-reg)             ((looking-at sml-indent-starters-reg)
# Line 862  Line 937 
937             ((looking-at ".*=>")             ((looking-at ".*=>")
938              (if (looking-at ".*\\bfn\\b.*=>")              (if (looking-at ".*\\bfn\\b.*=>")
939                  indent                  indent
940                (+ indent sml-indent-level)))                  (+ indent sml-indent-case-level)))
941             ;; else keep the same indentation as previous line             ;; else keep the same indentation as previous line
942             (t indent))))))))               (t indent)))))))))
943    
944  (defun sml-get-paren-indent ()  (defun sml-get-paren-indent ()
945    (save-excursion    (save-excursion

Legend:
Removed from v.38  
changed lines
  Added in v.39

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