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 891, Thu Jul 19 22:19:15 2001 UTC revision 892, Fri Jul 20 13:47:33 2001 UTC
# Line 103  Line 103 
103    "*If non-nil, `\;' will self insert, reindent the line, and do a newline.    "*If non-nil, `\;' will self insert, reindent the line, and do a newline.
104  If nil, just insert a `\;'.  (To insert while t, do: \\[quoted-insert] \;)."  If nil, just insert a `\;'.  (To insert while t, do: \\[quoted-insert] \;)."
105    :group 'sml    :group 'sml
106    :type '(boolean))    :type 'boolean)
107    
108    (defcustom sml-rightalign-and t
109      "If non-nil, right-align `and' with its leader.
110    If nil:                                 If t:
111            datatype a = A                          datatype a = A
112            and b = B                                    and b = B"
113      :group 'sml
114      :type 'boolean)
115    
116  ;;; OTHER GENERIC MODE VARIABLES  ;;; OTHER GENERIC MODE VARIABLES
117    
# Line 160  Line 168 
168                 "with" "withtype" "o")                 "with" "withtype" "o")
169    "A regexp that matches any and all keywords of SML.")    "A regexp that matches any and all keywords of SML.")
170    
171    (defconst sml-tyvarseq-re
172      "\\(\\('+\\(\\sw\\s_\\)+\\|(\\([,']\\|\\sw\\|\\s_\\|\\s-\\)+)\\)\\s-+\\)?")
173    
174  (defconst sml-font-lock-keywords  (defconst sml-font-lock-keywords
175    `(;;(sml-font-comments-and-strings)    `(;;(sml-font-comments-and-strings)
176      ("\\<\\(fun\\|and\\)\\s-+\\('\\sw+\\s-+\\)*\\(\\sw+\\)"      (,(concat "\\<\\(fun\\|and\\)\\s-+" sml-tyvarseq-re "\\(\\sw+\\)\\s-+[^ \t\n=]")
177       (1 font-lock-keyword-face)       (1 font-lock-keyword-face)
178       (3 font-lock-function-name-face))       (6 font-lock-function-name-face))
179      ("\\<\\(\\(data\\|abs\\|with\\|eq\\)?type\\)\\s-+\\('\\sw+\\s-+\\)*\\(\\sw+\\)"      (,(concat "\\<\\(\\(data\\|abs\\|with\\|eq\\)?type\\)\\s-+" sml-tyvarseq-re "\\(\\sw+\\)")
180       (1 font-lock-keyword-face)       (1 font-lock-keyword-face)
181       (4 font-lock-type-def-face))       (7 font-lock-type-def-face))
182      ("\\<\\(val\\)\\s-+\\(\\sw+\\>\\s-*\\)?\\(\\sw+\\)\\s-*[=:]"      ("\\<\\(val\\)\\s-+\\(\\sw+\\>\\s-*\\)?\\(\\sw+\\)\\s-*[=:]"
183       (1 font-lock-keyword-face)       (1 font-lock-keyword-face)
184       ;;(6 font-lock-variable-def-face nil t)       ;;(6 font-lock-variable-def-face nil t)
# Line 203  Line 214 
214  (defvar font-lock-interface-def-face 'font-lock-interface-def-face  (defvar font-lock-interface-def-face 'font-lock-interface-def-face
215    "Face name to use for interface definitions.")    "Face name to use for interface definitions.")
216    
217  ;;;  ;;
218  ;;; Code to handle nested comments and unusual string escape sequences  ;; Code to handle nested comments and unusual string escape sequences
219  ;;;  ;;
220    
221  (defsyntax sml-syntax-prop-table  (defsyntax sml-syntax-prop-table
222    '((?\\ . ".") (?* . "."))    '((?\\ . ".") (?* . "."))
# Line 257  Line 268 
268          (let ((kind (match-string 2))          (let ((kind (match-string 2))
269                (column (progn (goto-char (match-beginning 2)) (current-column)))                (column (progn (goto-char (match-beginning 2)) (current-column)))
270                (location                (location
271                 (progn (goto-char (match-end 0)) (sml-forward-spaces) (point)))                 (progn (goto-char (match-end 0))
272                          (sml-forward-spaces)
273                          (when (looking-at sml-tyvarseq-re)
274                            (goto-char (match-end 0)))
275                          (point)))
276                (name (sml-forward-sym)))                (name (sml-forward-sym)))
277            ;; Eliminate trivial renamings.            ;; Eliminate trivial renamings.
278            (when (or (not (member kind '("structure" "signature")))            (when (or (not (member kind '("structure" "signature")))
# Line 306  Line 321 
321    (set (make-local-variable 'comment-nested) t)    (set (make-local-variable 'comment-nested) t)
322    ;;(set (make-local-variable 'block-comment-start) "* ")    ;;(set (make-local-variable 'block-comment-start) "* ")
323    ;;(set (make-local-variable 'block-comment-end) "")    ;;(set (make-local-variable 'block-comment-end) "")
324    (set (make-local-variable 'comment-column) 40)    ;; (set (make-local-variable 'comment-column) 40)
325    (set (make-local-variable 'comment-start-skip) "(\\*+\\s-*"))    (set (make-local-variable 'comment-start-skip) "(\\*+\\s-*"))
326    
327    (defun sml-funname-of-and ()
328      "Name of the function this `and' defines, or nil if not a function.
329    Point has to be right after the `and' symbol and is not preserved."
330      (sml-forward-spaces)
331      (if (looking-at sml-tyvarseq-re) (goto-char (match-end 0)))
332      (let ((sym (sml-forward-sym)))
333        (sml-forward-spaces)
334        (unless (or (member sym '(nil "d="))
335                    (member (sml-forward-sym) '("d=")))
336          sym)))
337    
338  (defun sml-electric-pipe ()  (defun sml-electric-pipe ()
339    "Insert a \"|\".    "Insert a \"|\".
340  Depending on the context insert the name of function, a \"=>\" etc."  Depending on the context insert the name of function, a \"=>\" etc."
# Line 333  Line 359 
359                     ((looking-at "=") (concat f "  = "))))) ;a function                     ((looking-at "=") (concat f "  = "))))) ;a function
360                 ((string= sym "and")                 ((string= sym "and")
361                  ;; could be a datatype or a function                  ;; could be a datatype or a function
362                  (while (and (setq sym (sml-forward-sym))                  (setq sym (sml-funname-of-and))
363                              (string-match "^'" sym))                  (if sym (concat sym "  = ") ""))
                   (sml-forward-spaces))  
                 (sml-forward-spaces)  
                 (if (or (not sym)  
                         (equal (sml-forward-sym) "d="))  
                     ""  
                   (concat sym "  = ")))  
364                 ;; trivial cases                 ;; trivial cases
365                 ((string= sym "fun")                 ((string= sym "fun")
366                  (while (and (setq sym (sml-forward-sym))                  (while (and (setq sym (sml-forward-sym))
# Line 408  Line 428 
428        (while (> depth 0)        (while (> depth 0)
429          (if (re-search-backward "(\\*\\|\\*)" nil t)          (if (re-search-backward "(\\*\\|\\*)" nil t)
430              (cond              (cond
431                 ;; FIXME: That's just a stop-gap.
432                 ((eq (get-text-property (point) 'face) 'font-lock-string-face))
433               ((looking-at "*)") (incf depth))               ((looking-at "*)") (incf depth))
434               ((looking-at comment-start-skip) (decf depth)))               ((looking-at comment-start-skip) (decf depth)))
435            (setq depth -1)))            (setq depth -1)))
# Line 426  Line 448 
448             (sml-point (point))             (sml-point (point))
449             (sym (save-excursion (sml-forward-sym))))             (sym (save-excursion (sml-forward-sym))))
450         (or         (or
451          ;; allow the user to override the indentation          ;; Allow the user to override the indentation.
452          (when (looking-at (concat ".*" (regexp-quote comment-start)          (when (looking-at (concat ".*" (regexp-quote comment-start)
453                                    "[ \t]*fixindent[ \t]*"                                    "[ \t]*fixindent[ \t]*"
454                                    (regexp-quote comment-end)))                                    (regexp-quote comment-end)))
455            (current-indentation))            (current-indentation))
456    
457          ;; continued comment          ;; Continued comment.
458          (and (looking-at "\\*") (sml-find-comment-indent))          (and (looking-at "\\*") (sml-find-comment-indent))
459    
460          ;; Continued string ? (Added 890113 lbn)          ;; Continued string ? (Added 890113 lbn)
# Line 446  Line 468 
468                       (1+ (current-column))                       (1+ (current-column))
469                     0))))                     0))))
470    
471            ;; Closing parens.  Could be handled below with `sml-indent-relative'?
472            (and (looking-at "\\s)")
473                 (save-excursion
474                   (skip-syntax-forward ")")
475                   (backward-sexp 1)
476                   (if (sml-dangling-sym)
477                       (sml-indent-default 'noindent)
478                     (current-column))))
479    
480          (and (setq data (assoc sym sml-close-paren))          (and (setq data (assoc sym sml-close-paren))
481               (sml-indent-relative sym data))               (sml-indent-relative sym data))
482    
483          (and (member (save-excursion (sml-forward-sym)) sml-starters-syms)          (and (member sym sml-starters-syms)
484               (let ((sym (unless (save-excursion (sml-backward-arg))               (sml-indent-starter sym))
                           (sml-backward-spaces)  
                           (sml-backward-sym))))  
                (if sym (sml-get-sym-indent sym)  
                  ;; FIXME: this can take a *long* time !!  
                  (sml-find-matching-starter sml-starters-syms)  
                  (current-column))))  
485    
486          (and (string= sym "|") (sml-indent-pipe))          (and (string= sym "|") (sml-indent-pipe))
487    
488          (sml-indent-arg)          (sml-indent-arg)
489          (sml-indent-default))))))          (sml-indent-default))))))
490    
491    (defsubst sml-bolp ()
492      (save-excursion (skip-chars-backward " \t|") (bolp)))
493    
494    (defun sml-indent-starter (orig-sym)
495      "Return the indentation to use for a symbol in `sml-starters-syms'.
496    Point should be just before the symbol ORIG-SYM and is not preserved."
497      (let ((sym (unless (save-excursion (sml-backward-arg))
498                   (sml-backward-spaces)
499                   (sml-backward-sym))))
500        (if (equal sym "d=") (setq sym nil))
501        (if sym (sml-get-sym-indent sym)
502          ;; FIXME: this can take a *long* time !!
503          (setq sym (sml-find-matching-starter sml-starters-syms))
504          ;; Don't align with `and' because it might be specially indented.
505          (if (and (or (equal orig-sym "and") (not (equal sym "and")))
506                   (sml-bolp))
507              (+ (current-column)
508                 (if (and sml-rightalign-and (equal orig-sym "and"))
509                     (- (length sym) 3) 0))
510            (sml-indent-starter orig-sym)))))
511    
512  (defun sml-indent-relative (sym data)  (defun sml-indent-relative (sym data)
513    (save-excursion    (save-excursion
514      (sml-forward-sym) (sml-backward-sexp nil)      (sml-forward-sym) (sml-backward-sexp nil)
# Line 477  Line 523 
523        (if (string= sym "|")        (if (string= sym "|")
524            (if (sml-bolp) (current-column) (sml-indent-pipe))            (if (sml-bolp) (current-column) (sml-indent-pipe))
525          (let ((pipe-indent (or (cdr (assoc "|" sml-symbol-indent)) -2)))          (let ((pipe-indent (or (cdr (assoc "|" sml-symbol-indent)) -2)))
526            (when (member sym '("datatype" "abstype"))            (when (or (member sym '("datatype" "abstype"))
527                        (and (equal sym "and")
528                             (save-excursion
529                               (forward-word 1)
530                               (not (sml-funname-of-and)))))
531              (re-search-forward "="))              (re-search-forward "="))
532            (sml-forward-sym)            (sml-forward-sym)
533            (sml-forward-spaces)            (sml-forward-spaces)
# Line 517  Line 567 
567       (t sml-indent-level))))       (t sml-indent-level))))
568    
569  (defun sml-dangling-sym ()  (defun sml-dangling-sym ()
570      "Non-nil if the symbol after point is dangling.
571    The symbol can be an SML symbol or an open-paren. \"Dangling\" means that
572    it is not on its own line but is the last element on that line."
573    (save-excursion    (save-excursion
574      (and (not (sml-bolp))      (and (not (sml-bolp))
575           (< (sml-point-after (end-of-line))           (< (sml-point-after (end-of-line))
576              (sml-point-after (sml-forward-sym)              (sml-point-after (or (sml-forward-sym) (skip-syntax-forward "("))
577                               (sml-forward-spaces))))))                               (sml-forward-spaces))))))
578    
579  (defun sml-delegated-indent ()  (defun sml-delegated-indent ()
# Line 532  Line 585 
585    
586  (defun sml-get-sym-indent (sym &optional style)  (defun sml-get-sym-indent (sym &optional style)
587    "Find the indentation for the SYM we're `looking-at'.    "Find the indentation for the SYM we're `looking-at'.
588  If indentation is delegated, the point will be at the start of  If indentation is delegated, point will move to the start of the parent.
589  the parent at the end of this function.  Optional argument STYLE is currently ignored."
 Optional argument STYLE is currently ignored"  
590    (assert (equal sym (save-excursion (sml-forward-sym))))    (assert (equal sym (save-excursion (sml-forward-sym))))
591    (save-excursion    (save-excursion
592      (let ((delegate (assoc sym sml-close-paren))      (let ((delegate (assoc sym sml-close-paren))
# Line 569  Line 621 
621    (let* ((sym-after (save-excursion (sml-forward-sym)))    (let* ((sym-after (save-excursion (sml-forward-sym)))
622           (_ (sml-backward-spaces))           (_ (sml-backward-spaces))
623           (sym-before (sml-backward-sym))           (sym-before (sml-backward-sym))
624           (sym-indent (and sym-before (sml-get-sym-indent sym-before))))           (sym-indent (and sym-before (sml-get-sym-indent sym-before)))
625      (if sym-indent           (indent-after (or (cdr (assoc sym-after sml-symbol-indent)) 0)))
626        (when (equal sym-before "end")
627          ;; I don't understand what's really happening here, but when
628          ;; it's `end' clearly, we need to do something special.
629          (forward-word 1)
630          (setq sym-before nil sym-indent nil))
631        (cond
632         (sym-indent
633          ;; the previous sym is an indentation introducer: follow the rule          ;; the previous sym is an indentation introducer: follow the rule
         (let ((indent-after (or (cdr (assoc sym-after sml-symbol-indent)) 0)))  
634            (if noindent            (if noindent
635                ;;(current-column)                ;;(current-column)
636                sym-indent                sym-indent
637              (+ sym-indent indent-after)))              (+ sym-indent indent-after)))
638         ;; If we're just after a hanging open paren.
639         ((and (eq (char-syntax (preceding-char)) ?\()
640               (save-excursion (backward-char) (sml-dangling-sym)))
641          (backward-char)
642          (sml-indent-default))
643         (t
644        ;; default-default        ;; default-default
645        (let* ((prec-after (sml-op-prec sym-after 'back))        (let* ((prec-after (sml-op-prec sym-after 'back))
646               (prec (or (sml-op-prec sym-before 'back) prec-after 100)))               (prec (or (sml-op-prec sym-before 'back) prec-after 100)))
# Line 584  Line 648 
648          ;; "current one", or until you backed over a sym that has the same prec          ;; "current one", or until you backed over a sym that has the same prec
649          ;; but is at the beginning of a line.          ;; but is at the beginning of a line.
650          (while (and (not (sml-bolp))          (while (and (not (sml-bolp))
651                      (sml-move-if (sml-backward-sexp (1- prec)))                      (while (sml-move-if (sml-backward-sexp (1- prec))))
652                      (not (sml-bolp)))                      (not (sml-bolp)))
653            (while (sml-move-if (sml-backward-sexp prec))))            (while (sml-move-if (sml-backward-sexp prec))))
654            (if noindent
655          ;; the `noindent' case does back over an introductory symbol          ;; the `noindent' case does back over an introductory symbol
656          ;; such as `fun', ...          ;; such as `fun', ...
657          (when noindent              (progn
658                  (sml-move-if
659                   (sml-backward-spaces)
660                   (member (sml-backward-sym) sml-starters-syms))
661                  (current-column))
662              ;; Use `indent-after' for cases such as when , or ; should be
663              ;; outdented so that their following terms are aligned.
664              (+ (if (progn
665                       (if (equal sym-after ";")
666            (sml-move-if            (sml-move-if
667             (sml-backward-spaces)             (sml-backward-spaces)
668             (member (sml-backward-sym) sml-starters-syms)))             (member (sml-backward-sym) sml-starters-syms)))
669          (current-column)))))                     (and sym-after (not (looking-at sym-after))))
670                     indent-after 0)
671                 (current-column))))))))
 (defun sml-bolp ()  
   (save-excursion  
     (skip-chars-backward " \t|") (bolp)))  
672    
673    
674  ;; maybe `|' should be set to word-syntax in our temp syntax table ?  ;; maybe `|' should be set to word-syntax in our temp syntax table ?
# Line 771  Line 841 
841    (unless (or (not newline)    (unless (or (not newline)
842                (save-excursion (beginning-of-line) (looking-at "\\s-*$")))                (save-excursion (beginning-of-line) (looking-at "\\s-*$")))
843      (insert "\n"))      (insert "\n"))
844    (unless (/= ?w (char-syntax (char-before))) (insert " "))    (unless (/= ?w (char-syntax (preceding-char))) (insert " "))
845    (let ((f (cdr (assoc name sml-forms-alist))))    (let ((f (cdr (assoc name sml-forms-alist))))
846      (cond      (cond
847       ((commandp f) (command-execute f))       ((commandp f) (command-execute f))

Legend:
Removed from v.891  
changed lines
  Added in v.892

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