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 32, Thu Mar 12 16:54:39 1998 UTC revision 33, Thu Mar 12 16:57:15 1998 UTC
# Line 95  Line 95 
95  (defconst sml-mode-version-string  (defconst sml-mode-version-string
96    "sml-mode, version 3.3(beta)")    "sml-mode, version 3.3(beta)")
97    
98    (require 'cl)
99  (provide 'sml-mode)  (provide 'sml-mode)
100    
101  ;;; VARIABLES CONTROLLING INDENTATION  ;;; VARIABLES CONTROLLING INDENTATION
# Line 253  Line 254 
254  Full documentation will be available after autoloading the function."  Full documentation will be available after autoloading the function."
255    "Documentation for autoloading functions.")    "Documentation for autoloading functions.")
256    
257  (autoload 'sml             "sml-proc"   sml-no-doc t)  (autoload 'run-sml         "sml-proc"   sml-no-doc t)
258    (autoload 'sml-make        "sml-proc"   sml-no-doc t)
259  (autoload 'sml-load-file   "sml-proc"   sml-no-doc t)  (autoload 'sml-load-file   "sml-proc"   sml-no-doc t)
260    
261  (autoload 'switch-to-sml   "sml-proc"   sml-no-doc t)  (autoload 'switch-to-sml   "sml-proc"   sml-no-doc t)
# Line 265  Line 267 
267  (cond ((not sml-mode-map)  (cond ((not sml-mode-map)
268         (setq sml-mode-map (make-sparse-keymap))         (setq sml-mode-map (make-sparse-keymap))
269         (install-sml-keybindings sml-mode-map)         (install-sml-keybindings sml-mode-map)
270           (define-key sml-mode-map "\C-c\C-c" 'sml-make)
271         (define-key sml-mode-map "\C-c\C-s" 'switch-to-sml)         (define-key sml-mode-map "\C-c\C-s" 'switch-to-sml)
272         (define-key sml-mode-map "\C-c\C-r" 'sml-send-region)         (define-key sml-mode-map "\C-c\C-r" 'sml-send-region)
273         (define-key sml-mode-map "\C-c\C-b" 'sml-send-buffer)))         (define-key sml-mode-map "\C-c\C-b" 'sml-send-buffer)))
274    
275    ;; font-lock setup
276    
277    (defvar sml-font-lock-keywords
278      '((sml-font-comments-and-strings)
279        ("\\<\\(fun\\|and\\)\\s-+\\(\\sw+\\)"
280         (1 font-lock-keyword-face)
281         (2 font-lock-function-def-face))
282        ("\\<\\(\\(data\\|abs\\|with\\|eq\\)?type\\)\\s-+\\('\\s-*\\sw+\\s-+\\)*\\(\\sw+\\)"
283         (1 font-lock-keyword-face)
284         (4 font-lock-type-def-face))
285        ("\\<\\(val\\)\\s-+\\(\\sw+\\>\\s-*\\)?\\(\\sw+\\)\\s-*="
286         (1 font-lock-keyword-face)
287         ;;(6 font-lock-variable-def-face nil t)
288         (3 font-lock-variable-def-face))
289        ("\\<\\(structure\\|functor\\|abstraction\\)\\s-+\\(\\sw+\\)"
290         (1 font-lock-keyword-face)
291         (2 font-lock-module-def-face))
292        ("\\<\\(signature\\)\\s-+\\(\\sw+\\)"
293         (1 font-lock-keyword-face)
294         (2 font-lock-interface-def-face))
295    
296        ;; Generated with Simon Marshall's make-regexp:
297        ;; (make-regexp
298        ;;  '("abstype" "and" "andalso" "as" "case" "datatype"
299        ;;    "else" "end" "eqtype" "exception" "do" "fn" "fun" "functor"
300        ;;    "handle" "if" "in" "include" "infix" "infixr" "let" "local"
301        ;;    "nonfix" "of" "op" "open" "orelse" "overload" "raise" "rec"
302        ;;    "sharing" "sig" "signature" "struct" "structure" "then" "type"
303        ;;    "val" "where" "while" "with" "withtype") t)
304        ("\\<\\(a\\(bstype\\|nd\\(\\|also\\)\\|s\\)\\|case\\|d\\(atatype\\|o\\)\\|\
305    e\\(lse\\|nd\\|qtype\\|xception\\)\\|f\\(n\\|un\\(\\|ctor\\)\\)\\|\handle\\|\
306    i\\([fn]\\|n\\(clude\\|fixr?\\)\\)\\|l\\(et\\|ocal\\)\\|nonfix\\|\
307    o\\([fp]\\|pen\\|relse\\|verload\\)\\|r\\(aise\\|ec\\)\\|\
308    s\\(haring\\|ig\\(\\|nature\\)\\|truct\\(\\|ure\\)\\)\\|t\\(hen\\|ype\\)\\|\
309    val\\|w\\(h\\(ere\\|ile\\)\\|ith\\(\\|type\\)\\)\\)\\>"
310         . font-lock-keyword-face))
311      "Regexps matching standard SML keywords.")
312    
313    ;; default faces values
314    (defvar font-lock-function-def-face
315      (if (facep 'font-lock-function-def-face)
316          'font-lock-function-name-face
317        'font-lock-function-name-face))
318    (defvar font-lock-type-def-face
319      (if (facep 'font-lock-type-def-face)
320          'font-lock-type-def-face
321        'font-lock-type-face))
322    (defvar font-lock-module-def-face
323      (if (facep 'font-lock-module-def-face)
324          'font-lock-module-def-face
325        'font-lock-function-name-face))
326    (defvar font-lock-interface-def-face
327      (if (facep 'font-lock-interface-def-face)
328          'font-lock-interface-def-face
329        'font-lock-type-face))
330    (defvar font-lock-variable-def-face
331      (if (facep 'font-lock-variable-def-face)
332          'font-lock-variable-def-face
333        'font-lock-variable-name-face))
334    
335    (defvar sml-font-lock-defaults
336      '(sml-font-lock-keywords t nil nil nil))
337    
338    ;; code to get comment fontification working in the face of recursive
339    ;; comments.  It's lots more work than it should be.    -- stefan
340    (defvar sml-font-cache '((0 . normal))
341      "List of (POSITION . STATE) pairs for an SML buffer.
342    The STATE is either `normal', `comment', or `string'.  The POSITION is
343    immediately after the token that caused the state change.")
344    (make-variable-buffer-local 'sml-font-cache)
345    
346    (defun sml-font-comments-and-strings (limit)
347      "Fontify SML comments and strings up to LIMIT.
348    Handles nested comments and SML's escapes for breaking a string over lines.
349    Uses sml-font-cache to maintain the fontification state over the buffer."
350      (let ((beg (point))
351            last class)
352        (while (< beg limit)
353          (while (and sml-font-cache
354                      (> (caar sml-font-cache) beg))
355            (pop sml-font-cache))
356          (setq last (caar sml-font-cache))
357          (setq class (cdar sml-font-cache))
358          (goto-char last)
359          (cond
360           ((eq class 'normal)
361            (cond
362             ((not (re-search-forward "\\((\\*\\)\\|\\(\"\\)" limit t))
363              (goto-char limit))
364             ((match-beginning 1)
365              (push (cons (point) 'comment) sml-font-cache))
366             ((match-beginning 2)
367              (push (cons (point) 'string) sml-font-cache))))
368           ((eq class 'comment)
369            (cond
370             ((let ((nest 1))
371                (while (and (> nest 0)
372                            (re-search-forward "\\((\\*\\)\\|\\(\\*)\\)" limit t))
373                  (cond
374                   ((match-beginning 1) (incf nest))
375                   ((match-beginning 2) (decf nest))))
376                (> nest 0))
377              (goto-char limit))
378             (t
379              (push (cons (point) 'normal) sml-font-cache)))
380            (put-text-property (- last 2) (point) 'face 'font-lock-comment-face))
381           ((eq class 'string)
382            (while (and (re-search-forward
383                         "\\(\"\\)\\|\\(\\\\\\s-*\\\\\\)\\|\\(\\\\\"\\)" limit t)
384                         (not (match-beginning 1))))
385            (cond
386             ((match-beginning 1)
387              (push (cons (point) 'normal) sml-font-cache))
388             (t
389              (goto-char limit)))
390            (put-text-property (- last 1) (point) 'face 'font-lock-string-face)))
391          (setq beg (point)))))
392    
393  ;;; 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
394    
395  (cond ((fboundp 'make-extent)  (cond ((fboundp 'make-extent)
# Line 343  Line 464 
464        (setq i (1+ i))))        (setq i (1+ i))))
465    
466    ;; Now we change the characters that are meaningful to us.    ;; Now we change the characters that are meaningful to us.
467      (modify-syntax-entry ?\\      "\\"    sml-mode-syntax-table)
468    (modify-syntax-entry ?\(      "()1"   sml-mode-syntax-table)    (modify-syntax-entry ?\(      "()1"   sml-mode-syntax-table)
469    (modify-syntax-entry ?\)      ")(4"   sml-mode-syntax-table)    (modify-syntax-entry ?\)      ")(4"   sml-mode-syntax-table)
470    (modify-syntax-entry ?\[      "(]"    sml-mode-syntax-table)    (modify-syntax-entry ?\[      "(]"    sml-mode-syntax-table)
# Line 415  Line 537 
537    (set-syntax-table sml-mode-syntax-table)    (set-syntax-table sml-mode-syntax-table)
538    (setq local-abbrev-table sml-mode-abbrev-table)    (setq local-abbrev-table sml-mode-abbrev-table)
539    ;; A paragraph is separated by blank lines or ^L only.    ;; A paragraph is separated by blank lines or ^L only.
540    (make-local-variable 'paragraph-start)  
541    (setq paragraph-start (concat "^[\t ]*$\\|" page-delimiter))    (set (make-local-variable 'paragraph-start)
542    (make-local-variable 'paragraph-separate)         (concat "^[\t ]*$\\|" page-delimiter))
543    (setq paragraph-separate paragraph-start)    (set (make-local-variable 'paragraph-separate) paragraph-start)
544    (make-local-variable 'indent-line-function)    (set (make-local-variable 'indent-line-function) 'sml-indent-line)
545    (setq indent-line-function 'sml-indent-line)    (set (make-local-variable 'comment-start) "(* ")
546    (make-local-variable 'comment-start)    (set (make-local-variable 'comment-end) " *)")
547    (setq comment-start "(* ")    (set (make-local-variable 'comment-column) 40)
548    (make-local-variable 'comment-end)    (set (make-local-variable 'comment-start-skip) "(\\*+[ \t]?")
549    (setq comment-end " *)")    (set (make-local-variable 'comment-indent-function) 'sml-comment-indent)
550    (make-local-variable 'comment-column)    (set (make-local-variable 'font-lock-defaults) sml-font-lock-defaults)
   (setq comment-column 40)  
   (make-local-variable 'comment-start-skip)  
   (setq comment-start-skip "(\\*+[ \t]?")  
   (make-local-variable 'comment-indent-function)  
   (setq comment-indent-function 'sml-comment-indent)  
551    (setq sml-error-overlay (and sml-error-overlay (sml-make-overlay))))    (setq sml-error-overlay (and sml-error-overlay (sml-make-overlay))))
552    
553    ;; Adding these will fool the matching of parens -- because of a    ;; Adding these will fool the matching of parens -- because of a

Legend:
Removed from v.32  
changed lines
  Added in v.33

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