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 534, Thu Feb 17 22:14:04 2000 UTC revision 535, Fri Feb 18 16:49:10 2000 UTC
# Line 1  Line 1 
1  ;;; sml-mode.el. Major mode for editing (Standard) ML  ;;; sml-mode.el --- Major mode for editing (Standard) ML
2    
3  (defconst rcsid-sml-mode "@(#)$Name$:$Id$")  (defconst rcsid-sml-mode "@(#)$Name$:$Id$")
4    
# Line 28  Line 28 
28    
29  ;; ====================================================================  ;; ====================================================================
30    
31    
32    ;;; Commentary:
33    ;;
34    
35  ;;; HISTORY  ;;; HISTORY
36    
37  ;; Still under construction: History obscure, needs a biographer as  ;; Still under construction: History obscure, needs a biographer as
# Line 79  Line 83 
83  ;;                indent-tabs-mode nil)))    ; whatever  ;;                indent-tabs-mode nil)))    ; whatever
84    
85  ;; sml-mode-hook is run whenever a new sml-mode buffer is created.  ;; sml-mode-hook is run whenever a new sml-mode buffer is created.
 ;; There is an sml-load-hook too, which is only run when this file is  
 ;; loaded. One use for this hook is to select your preferred  
 ;; highlighting scheme, like this:  
   
 ;; (setq sml-load-hook  
 ;;       '(lambda() "Highlights." (require 'sml-hilite)))  
   
 ;; hilit19 is the magic that actually does the highlighting. My set up  
 ;; for hilit19 runs something like this:  
   
 ;; (if window-system  
 ;;     (setq hilit-background-mode   t ; monochrome (alt: 'dark or 'light)  
 ;;           hilit-inhibit-hooks     nil  
 ;;           hilit-inhibit-rebinding nil  
 ;;           hilit-quietly           t))  
   
 ;; Alternatively, you can (require 'sml-font) which uses the font-lock  
 ;; package instead.  
86    
87  ;; Finally, there are inferior-sml-{mode,load}-hooks -- see comments  ;; Finally, there are inferior-sml-{mode,load}-hooks -- see comments
88  ;; in sml-proc.el. For much more information consult the mode's *info*  ;; in sml-proc.el. For much more information consult the mode's *info*
89  ;; tree.  ;; tree.
90    
91  ;;; VERSION STRING  ;;; Code:
   
 (defconst sml-mode-version "version $Name$")  
92    
93  (require 'cl)  (require 'cl)
94  (require 'sml-util)  (require 'sml-util)
# Line 137  Line 121 
121    
122  (defcustom sml-electric-semi-mode nil  (defcustom sml-electric-semi-mode nil
123    "*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.
124  If nil, just insert a `\;'. (To insert while t, do: C-q \;)."  If nil, just insert a `\;'.  (To insert while t, do: \\[quoted-insert] \;)."
125    :group 'sml    :group 'sml
126    :type '(boolean))    :type '(boolean))
127    
128  ;;; OTHER GENERIC MODE VARIABLES  ;;; OTHER GENERIC MODE VARIABLES
129    
130  (defvar sml-mode-info "sml-mode"  (defvar sml-mode-info "sml-mode"
131    "*Where to find Info file for sml-mode.    "*Where to find Info file for `sml-mode'.
132  The default assumes the info file \"sml-mode.info\" is on Emacs' info  The default assumes the info file \"sml-mode.info\" is on Emacs' info
133  directory path. If it is not, either put the file on the standard path  directory path. If it is not, either put the file on the standard path
134  or set the variable sml-mode-info to the exact location of this file  or set the variable `sml-mode-info' to the exact location of this file
 which is part of the sml-mode 3.2 (and later) distribution. E.g:  
135    
136    (setq sml-mode-info \"/usr/me/lib/info/sml-mode\")    (setq sml-mode-info \"/usr/me/lib/info/sml-mode\")
137    
# Line 156  Line 139 
139  set-variable command.")  set-variable command.")
140    
141  (defvar sml-mode-hook nil  (defvar sml-mode-hook nil
142    "*This hook is run when sml-mode is loaded, or a new sml-mode buffer created.    "*Run upon entering `sml-mode'.
143  This is a good place to put your preferred key bindings.")  This is a good place to put your preferred key bindings.")
144    
145  (defvar sml-load-hook nil  (defvar sml-mode-abbrev-table nil "*Abbrev table for `sml-mode'.")
   "*This hook is run when sml-mode (sml-mode.el) is loaded into Emacs.")  
   
 (defvar sml-mode-abbrev-table nil "*SML mode abbrev table (default nil)")  
146    
147  ;;; CODE FOR SML-MODE  ;;; CODE FOR SML-MODE
148    
149  (defun sml-mode-info ()  (defun sml-mode-info ()
150    "Command to access the TeXinfo documentation for sml-mode.    "Command to access the TeXinfo documentation for `sml-mode'.
151  See doc for the variable sml-mode-info."  See doc for the variable `sml-mode-info'."
152    (interactive)    (interactive)
153    (require 'info)    (require 'info)
154    (condition-case nil    (condition-case nil
155        (Info-goto-node (concat "(" sml-mode-info ")"))        (info sml-mode-info)
156      (error (progn      (error (progn
157               (describe-variable 'sml-mode-info)               (describe-variable 'sml-mode-info)
158               (message "Can't find it... set this variable first!")))))               (message "Can't find it... set this variable first!")))))
# Line 200  Line 180 
180                 "infixr" "let" "local" "nonfix" "of" "op" "open" "orelse"                 "infixr" "let" "local" "nonfix" "of" "op" "open" "orelse"
181                 "overload" "raise" "rec" "sharing" "sig" "signature"                 "overload" "raise" "rec" "sharing" "sig" "signature"
182                 "struct" "structure" "then" "type" "val" "where" "while"                 "struct" "structure" "then" "type" "val" "where" "while"
183                 "with" "withtype")                 "with" "withtype" "o")
184    "A regexp that matches any and all keywords of SML.")    "A regexp that matches any and all keywords of SML.")
185    
186  (defconst sml-font-lock-keywords  (defconst sml-font-lock-keywords
# Line 246  Line 226 
226  (defvar font-lock-interface-def-face 'font-lock-interface-def-face  (defvar font-lock-interface-def-face 'font-lock-interface-def-face
227    "Face name to use for interface definitions.")    "Face name to use for interface definitions.")
228    
229  (defvar sml-syntax-prop-table  ;;;
230    (let ((st (make-syntax-table)))  ;;; Code to handle nested comments and unusual string escape sequences
231      ;;(modify-syntax-entry ?l "(d" st)  ;;;
232      ;;(modify-syntax-entry ?s "(d" st)  
233      ;;(modify-syntax-entry ?d ")l" st)  (defsyntax sml-syntax-prop-table
234      (modify-syntax-entry ?\\ "." st)    '((?\\ . ".") (?* . "."))
235      (modify-syntax-entry ?* "." st)    "Syntax table for text-properties")
     st))  
236    
237    ;; For Emacsen that have no built-in support for nested comments
238  (defun sml-get-depth-st ()  (defun sml-get-depth-st ()
239    (save-excursion    (save-excursion
240      (let* ((disp (if (eq (char-before) ?\)) (progn (backward-char) -1) nil))      (let* ((disp (if (eq (char-before) ?\)) (progn (backward-char) -1) nil))
# Line 274  Line 254 
254            (when depth sml-syntax-prop-table))))))            (when depth sml-syntax-prop-table))))))
255    
256  (defconst sml-font-lock-syntactic-keywords  (defconst sml-font-lock-syntactic-keywords
257    `(;;("\\<\\(l\\)\\(et\\|ocal\\)\\>" (1 ',sml-syntax-prop-table))    `(("^\\s-*\\(\\\\\\)" (1 ',sml-syntax-prop-table))
258      ;;("\\<\\(s\\)\\(ig\\truct\\)\\>" (1 ',sml-syntax-prop-table))      ,@(unless sml-builtin-nested-comments-flag
259      ;;("\\<en\\(d\\)\\>" (1 ',sml-syntax-prop-table))          '(("(?\\(\\*\\))?" (1 (sml-get-depth-st)))))))
     ("^\\s-*\\(\\\\\\)" (1 ',sml-syntax-prop-table))  
     ("(?\\(\\*\\))?" (1 (sml-get-depth-st)))))  
260    
261  (defconst sml-font-lock-defaults  (defconst sml-font-lock-defaults
262    '(sml-font-lock-keywords nil nil ((?_ . "w") (?' . "w")) nil    '(sml-font-lock-keywords nil nil ((?_ . "w") (?' . "w")) nil
# Line 287  Line 265 
265    
266  ;;; MORE CODE FOR SML-MODE  ;;; MORE CODE FOR SML-MODE
267    
268  (defun sml-mode-version ()  ;;;###Autoload
269    "This file's version number (sml-mode)."  (add-to-list 'auto-mode-alist '("\\.s\\(ml\\|ig\\)\\'" . sml-mode))
   (interactive)  
   (message sml-mode-version))  
270    
271  ;;;###Autoload  ;;;###Autoload
272  (defun sml-mode ()  (define-derived-mode sml-mode fundamental-mode "SML"
273    "Major mode for editing ML code.    "\\<sml-mode-map>Major mode for editing ML code.
274  Entry to this mode runs the hooks on `sml-mode-hook'.  This mode runs `sml-mode-hook' just before exiting.
275  \\{sml-mode-map}"  \\{sml-mode-map}"
276      (set (make-local-variable 'font-lock-defaults) sml-font-lock-defaults)
   (interactive)  
   (kill-all-local-variables)  
   (sml-mode-variables)  
   (use-local-map sml-mode-map)  
   (setq major-mode 'sml-mode)  
   (setq mode-name "SML")  
277    (set (make-local-variable 'outline-regexp) sml-outline-regexp)    (set (make-local-variable 'outline-regexp) sml-outline-regexp)
278    (run-hooks 'sml-mode-hook))            ; Run the hook last    (sml-mode-variables))
279    
280  (defun sml-mode-variables ()  (defun sml-mode-variables ()
281    (set-syntax-table sml-mode-syntax-table)    (set-syntax-table sml-mode-syntax-table)
# Line 318  Line 288 
288    (set (make-local-variable 'indent-line-function) 'sml-indent-line)    (set (make-local-variable 'indent-line-function) 'sml-indent-line)
289    (set (make-local-variable 'comment-start) "(* ")    (set (make-local-variable 'comment-start) "(* ")
290    (set (make-local-variable 'comment-end) " *)")    (set (make-local-variable 'comment-end) " *)")
291      (set (make-local-variable 'comment-nested) t)
292    ;;(set (make-local-variable 'block-comment-start) "* ")    ;;(set (make-local-variable 'block-comment-start) "* ")
293    ;;(set (make-local-variable 'block-comment-end) "")    ;;(set (make-local-variable 'block-comment-end) "")
294    (set (make-local-variable 'comment-column) 40)    (set (make-local-variable 'comment-column) 40)
295    (set (make-local-variable 'comment-start-skip) "(\\*+\\s-*")    (set (make-local-variable 'comment-start-skip) "(\\*+\\s-*")
296    (set (make-local-variable 'comment-indent-function) 'sml-comment-indent)    (set (make-local-variable 'comment-indent-function) 'sml-comment-indent))
   (set (make-local-variable 'font-lock-defaults) sml-font-lock-defaults))  
297    
298  (defun sml-electric-pipe ()  (defun sml-electric-pipe ()
299    "Insert a \"|\".    "Insert a \"|\".
# Line 368  Line 338 
338                 (t (error "Wow, now, there's a bug")))))))                 (t (error "Wow, now, there's a bug")))))))
339    
340       (insert text)       (insert text)
341       (sml-indent-line)       (indent-according-to-mode)
342       (beginning-of-line)       (beginning-of-line)
343       (skip-chars-forward "\t |")       (skip-chars-forward "\t |")
344       (skip-syntax-forward "w")       (skip-syntax-forward "w")
# Line 376  Line 346 
346       (when (= ?= (char-after)) (backward-char)))))       (when (= ?= (char-after)) (backward-char)))))
347    
348  (defun sml-electric-semi ()  (defun sml-electric-semi ()
349    "Inserts a \;.    "Insert a \;.
350  If variable sml-electric-semi-mode is t, indent the current line, insert  If variable `sml-electric-semi-mode' is t, indent the current line, insert
351  a newline, and indent."  a newline, and indent."
352    (interactive)    (interactive)
353    (insert "\;")    (insert "\;")
# Line 387  Line 357 
357  ;;; INDENTATION !!!  ;;; INDENTATION !!!
358    
359  (defun sml-mark-function ()  (defun sml-mark-function ()
360    "Synonym for mark-paragraph -- sorry.    "Synonym for `mark-paragraph' -- sorry.
361  If anyone has a good algorithm for this..."  If anyone has a good algorithm for this..."
362    (interactive)    (interactive)
363    (mark-paragraph))    (mark-paragraph))
# Line 400  Line 370 
370  ;;     (goto-char end) (setq end (point-marker)) (goto-char begin)  ;;     (goto-char end) (setq end (point-marker)) (goto-char begin)
371  ;;     (while (< (point) end)  ;;     (while (< (point) end)
372  ;;       (skip-chars-forward "\t\n ")  ;;       (skip-chars-forward "\t\n ")
373  ;;       (sml-indent-line)  ;;       (indent-according-to-mode)
374  ;;       (end-of-line))  ;;       (end-of-line))
375  ;;     (move-marker end nil))  ;;     (move-marker end nil))
376  ;;   (message "Indenting region... done"))  ;;   (message "Indenting region... done"))
# Line 408  Line 378 
378  (defun sml-indent-line ()  (defun sml-indent-line ()
379    "Indent current line of ML code."    "Indent current line of ML code."
380    (interactive)    (interactive)
381    (let ((indent (sml-calculate-indentation)))    (indent-line-to (sml-calculate-indentation)))
     (if (/= (current-indentation) indent)  
         (save-excursion                 ;; Added 890601 (point now stays)  
           (let ((beg (progn (beginning-of-line) (point))))  
             (skip-chars-forward "\t ")  
             (delete-region beg (point))  
             (indent-to indent))))  
     ;; If point is before indentation, move point to indentation  
     (if (< (current-column) (current-indentation))  
         (skip-chars-forward "\t "))))  
382    
383  (defun sml-back-to-outer-indent ()  (defun sml-back-to-outer-indent ()
384    "Unindents to the next outer level of indentation."    "Unindents to the next outer level of indentation."
# Line 564  Line 525 
525      (current-column)))      (current-column)))
526    
527  (defun sml-get-sym-indent (sym &optional style)  (defun sml-get-sym-indent (sym &optional style)
528    "expects to be looking-at SYM.    "Find the indentation for the SYM we're `looking-at'.
529  If indentation is delegated, the point will be at the start of  If indentation is delegated, the point will be at the start of
530  the parent at the end of this function."  the parent at the end of this function.
531    Optional argument STYLE is currently ignored"
532    (assert (equal sym (save-excursion (sml-forward-sym))))    (assert (equal sym (save-excursion (sml-forward-sym))))
533    (save-excursion    (save-excursion
534      (let ((delegate (assoc sym sml-close-paren))      (let ((delegate (assoc sym sml-close-paren))
# Line 656  Line 618 
618  ;;; INSERTING PROFORMAS (COMMON SML-FORMS)  ;;; INSERTING PROFORMAS (COMMON SML-FORMS)
619    
620  (defvar sml-forms-alist nil  (defvar sml-forms-alist nil
621    "*The alist of templates to auto-insert.    "*Alist of code templates.
   
622  You can extend this alist to your heart's content. For each additional  You can extend this alist to your heart's content. For each additional
623  template NAME in the list, declare a keyboard macro or function (or  template NAME in the list, declare a keyboard macro or function (or
624  interactive command) called 'sml-form-NAME'.  interactive command) called 'sml-form-NAME'.
   
625  If 'sml-form-NAME' is a function it takes no arguments and should  If 'sml-form-NAME' is a function it takes no arguments and should
626  insert the template at point\; if this is a command it may accept any  insert the template at point\; if this is a command it may accept any
627  sensible interactive call arguments\; keyboard macros can't take  sensible interactive call arguments\; keyboard macros can't take
628  arguments at all. Apropos keyboard macros, see `name-last-kbd-macro'  arguments at all. Apropos keyboard macros, see `name-last-kbd-macro'
629  and `sml-addto-forms-alist'.  and `sml-addto-forms-alist'.
   
630  `sml-forms-alist' understands let, local, case, abstype, datatype,  `sml-forms-alist' understands let, local, case, abstype, datatype,
631  signature, structure, and functor by default.")  signature, structure, and functor by default.")
632    
# Line 735  Line 694 
694        (sml-insert-form sym nil))))        (sml-insert-form sym nil))))
695    
696  (defun sml-insert-form (name newline)  (defun sml-insert-form (name newline)
697    "Interactive short-cut to insert a common ML form.    "Interactive short-cut to insert the NAME common ML form.
698  If a perfix argument is given insert a newline and indent first, or  If a prefix argument is given insert a NEWLINE and indent first, or
699  just move to the proper indentation if the line is blank\; otherwise  just move to the proper indentation if the line is blank\; otherwise
700  insert at point (which forces indentation to current column).  insert at point (which forces indentation to current column).
701    
# Line 782  Line 741 
741      (message "Macro bound to %s" fsym)      (message "Macro bound to %s" fsym)
742      (add-to-list 'sml-forms-alist (cons name fsym))))      (add-to-list 'sml-forms-alist (cons name fsym))))
743    
744  ;; at a pinch these could be added to SML/Forms menu through the good  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
745  ;; offices of activate-menubar-hook or something... but documentation  ;;;;  SML/NJ's Compilation Manager support  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
746  ;; of this and/or menu-bar-update-hook is sparse in 19.33. anyway, use  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
747  ;; completing read for sml-insert-form prompt...  
748    ;;;###autoload
749    (add-to-list 'completion-ignored-extensions "CM/")
750    ;;;###autoload
751    (add-to-list 'auto-mode-alist '("\\.cm\\'" . sml-cm-mode))
752    ;;;###autoload
753    (define-generic-mode 'sml-cm-mode
754      '(("(*" . "*)"))
755      '("library" "Library" "LIBRARY" "group" "Group" "GROUP" "is" "IS"
756        "structure" "functor" "signature" "funsig")
757      nil '("\\.cm\\'")
758      (list (lambda () (local-set-key "\C-c\C-c" 'sml-compile)))
759      "Generic mode for SML/NJ's Compilation Manager configuration files.")
760    
 ;;; & do the user's customisation  
 (run-hooks 'sml-load-hook)  
761    
 ;;; sml-mode.el has just finished.  
762  (provide 'sml-mode)  (provide 'sml-mode)
763    
764    ;;; sml-mode.el ends here

Legend:
Removed from v.534  
changed lines
  Added in v.535

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