![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to sml-mode.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / sml / lib / emacs|
Return to sml-mode.el CVS log | Up to [Research Unix] / researchv10no / cmd / sml / lib / emacs |
1.1 ! root 1: ;; sml-mode.el. Major mode for editing (Standard) ML. ! 2: ;; Copyright (C) 1989, Free Software Foundation, Inc. ! 3: ! 4: ;; This file is part of GNU Emacs. ! 5: ! 6: ;; GNU Emacs is distributed in the hope that it will be useful, ! 7: ;; but WITHOUT ANY WARRANTY. No author or distributor ! 8: ;; accepts responsibility to anyone for the consequences of using it ! 9: ;; or for whether it serves any particular purpose or works at all, ! 10: ;; unless he says so in writing. Refer to the GNU Emacs General Public ! 11: ;; License for full details. ! 12: ! 13: ;; Everyone is granted permission to copy, modify and redistribute ! 14: ;; GNU Emacs, but only under the conditions described in the ! 15: ;; GNU Emacs General Public License. A copy of this license is ! 16: ;; supposed to have been given to you along with GNU Emacs so you ! 17: ;; can know your rights and responsibilities. It should be in a ! 18: ;; file named COPYING. Among other things, the copyright notice ! 19: ;; and this notice must be preserved on all copies. ! 20: ! 21: ;; AUTHOR Lars Bo Nielsen ! 22: ;; Aalborg University ! 23: ;; Computer Science Dept. ! 24: ;; 9000 Aalborg ! 25: ;; Denmark ! 26: ;; ! 27: ;; EMAIL [email protected] ! 28: ;; or: ...!mcvax!diku!iesd!lbn ! 29: ;; or: [email protected] ! 30: ;; ! 31: ;; Please let me know if you come up with any ideas, bugs, or fixes. ! 32: ;; ! 33: ! 34: ! 35: (provide 'sml-mode) ! 36: ! 37: (defconst sml-mode-version-string ! 38: "SML-MODE, Version 2.4 (Oct 1989) ([email protected])") ! 39: ! 40: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ! 41: ;;; ! 42: ;;; CONSTANTS CONTROLLING THE MODE. ! 43: ;;; ! 44: ;;; These are the constants you might want to change ! 45: ;;; ! 46: ! 47: ;; The amount of indentation of blocks ! 48: (defconst sml-indent-level 4 "*Indentation of blocks in sml.") ! 49: ! 50: ;; The amount of negative indentation of lines beginning with "|" ! 51: (defconst sml-pipe-indent -2 ! 52: "*Extra (negative) indentation for lines beginning with |.") ; ! 53: ! 54: ;; How do we indent case-of expressions. ! 55: (defconst sml-case-indent nil ! 56: "*How to indent case-of expressions. ! 57: If t: case expr If nil: case expr of ! 58: of exp1 => ... exp1 => ... ! 59: | exp2 => ... | exp2 => ... ! 60: \nThe first seems to be the standard in NJ-SML. The second is the default.") ! 61: ! 62: (defconst sml-nested-if-indent nil ! 63: "*If set to t, nested if-then-else expression will have the same ! 64: indentation as: ! 65: if exp1 then exp2 ! 66: else if exp3 then exp4 ! 67: else if exp5 then exp6 ! 68: else exp7") ! 69: ! 70: (defconst sml-type-of-indent t ! 71: "*How to indent `let' `struct' etc. ! 72: ! 73: If t: fun foo bar = let If nil: fun foo bar = let ! 74: val p = 4 val p = 4 ! 75: in in ! 76: bar + p bar + p ! 77: end end ! 78: ! 79: Will not have any effect if the starting keyword is first on the line.") ! 80: ! 81: (defconst sml-electric-semi-mode t ! 82: "*If t, a `\;' will insert itself, reindent the line, and perform a newline. ! 83: If nil, just insert a `\;'. (To insert while t, do: C-q \;).") ! 84: ! 85: ;; How far should the indentation algorithm look to find open parenthesis ! 86: (defconst sml-paren-lookback 200 ! 87: "*Determines how far back (in chars) the indentation algorithm ! 88: should look for open parenthesis. High value means slow indentation ! 89: algorithm. A value of 200 (being the equivalent of 4-6 lines) should ! 90: suffice most uses. (A value of nil, means do not look at all)") ! 91: ! 92: ;; The command used to start up the sml-program. ! 93: (defconst sml-prog-name "sml" "*Name of program to run as sml.") ! 94: ! 95: ;; If t, you will be asked which program to run when the inferior ! 96: ;; shell starts up. Usefull if you have exported images of sml. ! 97: (defconst sml-prog-name-ask-p nil ! 98: "*Should you be asked for the name of the program to run.") ! 99: ! 100: ;; The left delimmitter for `use file' ! 101: (defconst sml-use-left-delim "\"" ! 102: "*The left delimiter for the filename when using \"use\". ! 103: To be set to `[\\\"' for Edinburgh SML, and `\\\"' for New Jersey SML. ! 104: Correspondes to `sml-use-right-delim'.") ! 105: ! 106: ;; The right delimmitter for `use file' ! 107: (defconst sml-use-right-delim "\"" ! 108: "*The right delimiter for the filename when using \"use\". ! 109: To be set to `\\\"]' for Edinburgh SML, and `\\\"' for New Jersey SML. ! 110: Correspondes to `sml-use-left-delim'.") ! 111: ! 112: ;; A regular expression matching the prompt pattern in the inferior ! 113: ;; shell ! 114: (defconst sml-shell-prompt-pattern "^[^\-=]*[\-=] *" ! 115: "*The prompt pattern for the inferion shell running sml.") ! 116: ! 117: ;; The template used for temporary files, created when a region is ! 118: ;; send to the inferior process running sml. ! 119: (defconst sml-tmp-template "/tmp/sml.tmp." ! 120: "*Template for the temporary file, created by sml-simulate-send-region.") ! 121: ! 122: ;; The name of the process running sml (This will also be the name of ! 123: ;; the buffer). ! 124: (defconst sml-process-name "SML" "*The name of the SML-process") ! 125: ! 126: ;;; ! 127: ;;; END OF CONSTANTS CONTROLLING THE MODE. ! 128: ;;; ! 129: ;;; If you change anything below, you are on your own. ! 130: ;;; ! 131: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ! 132: ! 133: ! 134: (defvar sml-mode-map nil "The mode map used in sml-mode.") ! 135: (if sml-mode-map ! 136: () ! 137: (setq sml-mode-map (make-sparse-keymap)) ! 138: (define-key sml-mode-map "\C-c'" 'sml-next-error) ! 139: (define-key sml-mode-map "\C-c\C-v" 'sml-mode-version) ! 140: (define-key sml-mode-map "\C-c\C-u" 'sml-save-buffer-use-file) ! 141: (define-key sml-mode-map "\C-c\C-s" 'sml-pop-to-shell) ! 142: (define-key sml-mode-map "\C-c\C-r" 'sml-send-region) ! 143: (define-key sml-mode-map "\C-c\C-m" 'sml-region) ! 144: (define-key sml-mode-map "\C-c\C-k" 'sml-skip-errors) ! 145: (define-key sml-mode-map "\C-c\C-f" 'sml-run-on-file) ! 146: (define-key sml-mode-map "\C-c\C-c" 'sml-send-function) ! 147: (define-key sml-mode-map "\C-c\C-b" 'sml-send-buffer) ! 148: (define-key sml-mode-map "\C-ci" 'sml-import-file) ! 149: (define-key sml-mode-map "\e|" 'sml-electric-pipe) ! 150: (define-key sml-mode-map "\C-j" 'reindent-then-newline-and-indent) ! 151: (define-key sml-mode-map "\177" 'backward-delete-char-untabify) ! 152: (define-key sml-mode-map "\;" 'sml-electric-semi) ! 153: (define-key sml-mode-map "\C-c\t" 'sml-indent-region) ! 154: (define-key sml-mode-map "\t" 'sml-indent-line)) ! 155: ! 156: (defvar sml-mode-syntax-table nil "The syntax table used in sml-mode.") ! 157: (if sml-mode-syntax-table ! 158: () ! 159: (setq sml-mode-syntax-table (make-syntax-table)) ! 160: (modify-syntax-entry ?\( "()1" sml-mode-syntax-table) ! 161: (modify-syntax-entry ?\) ")(4" sml-mode-syntax-table) ! 162: (modify-syntax-entry ?\\ "\\" sml-mode-syntax-table) ! 163: (modify-syntax-entry ?* ". 23" sml-mode-syntax-table) ! 164: ;; Special characters in sml-mode to be treated as normal ! 165: ;; characters: ! 166: (modify-syntax-entry ?_ "w" sml-mode-syntax-table) ! 167: (modify-syntax-entry ?\' "w" sml-mode-syntax-table)) ! 168: ! 169: ! 170: (defun sml-mode () ! 171: "Major mode for editing SML code. ! 172: Tab indents for SML code. ! 173: Comments are delimited with (* ... *). ! 174: Paragraphs are separated by blank lines only. ! 175: Delete converts tabs to spaces as it moves back. ! 176: ! 177: Key bindings: ! 178: ============= ! 179: ! 180: \\[sml-indent-line]\t - Indent current line. ! 181: \\[reindent-then-newline-and-indent]\t - Reindent line, newline and indent. ! 182: \\[sml-indent-region]\t - Indent region. ! 183: \\[sml-electric-pipe]\t - Insert a \"|\". Insert function name, \"=>\" etc. ! 184: \\[sml-region]\t - Insert a common used structure. ! 185: \\[sml-pop-to-shell]\t - Pop to the sml window. ! 186: \\[sml-next-error]\t - Find the next error. ! 187: \\[sml-save-buffer-use-file]\t - Save the buffer, and send a \"use file\". ! 188: \\[sml-send-region]\t - Send region (point and mark) to sml. ! 189: \\[sml-run-on-file]\t - Send a \"use file\" to sml. ! 190: \\[sml-import-file]\t - Send a \"import file\" to sml. ! 191: \\[sml-send-function]\t - Send function to sml. ! 192: \\[sml-send-buffer]\t - Send whole buffer to sml. ! 193: \\[sml-mode-version]\t - Get the version of sml-mode ! 194: ! 195: ! 196: Variables controlling the indentation ! 197: ===================================== ! 198: ! 199: sml-indent-level (default 4) ! 200: The indentation of a block of code. ! 201: ! 202: sml-pipe-indent (default -2) ! 203: Extra indentation of a line starting with \"|\". ! 204: ! 205: sml-case-indent (default nil) ! 206: Determine the way to indent case-of expression. ! 207: If t: case expr If nil: case expr of ! 208: of exp1 => ... exp1 => ... ! 209: | exp2 => ... | exp2 => ... ! 210: ! 211: The first seems to be the standard in NJ-SML. The second is the default. ! 212: ! 213: sml-nested-if-indent (default nil) ! 214: If set to t, nested if-then-else expression will have the same ! 215: indentation as: ! 216: if exp1 then exp2 ! 217: else if exp3 then exp4 ! 218: else if exp5 then exp6 ! 219: else exp7 ! 220: ! 221: sml-type-of-indent (default t) ! 222: How to indent `let' `struct' etc. ! 223: ! 224: If t: fun foo bar = let If nil: fun foo bar = let ! 225: val p = 4 val p = 4 ! 226: in in ! 227: bar + p bar + p ! 228: end end ! 229: ! 230: Will not have any effect if the starting keyword is first on the line. ! 231: ! 232: sml-electric-semi-mode (default t) ! 233: If t, a `\;' will reindent line, and perform a newline. ! 234: ! 235: Mode map ! 236: ======== ! 237: \\{sml-mode-map} ! 238: Runs sml-mode-hook if non nil." ! 239: (interactive) ! 240: (kill-all-local-variables) ! 241: (use-local-map sml-mode-map) ! 242: (setq major-mode 'sml-mode) ! 243: (setq mode-name "Sml") ! 244: (define-abbrev-table 'sml-mode-abbrev-table ()) ! 245: (setq local-abbrev-table sml-mode-abbrev-table) ! 246: (set-syntax-table sml-mode-syntax-table) ! 247: ;; A paragraph is seperated by blank lines (or ^L) only. ! 248: (make-local-variable 'paragraph-start) ! 249: (setq paragraph-start (concat "^[\t ]*$\\|" page-delimiter)) ! 250: (make-local-variable 'paragraph-separate) ! 251: (setq paragraph-separate paragraph-start) ! 252: (make-local-variable 'indent-line-function) ! 253: (setq indent-line-function 'sml-indent-line) ! 254: (make-local-variable 'require-final-newline) ; Always put a new-line ! 255: (setq require-final-newline t) ; in the end of file ! 256: (make-local-variable 'comment-start) ! 257: (setq comment-start "(* ") ! 258: (make-local-variable 'comment-end) ! 259: (setq comment-end " *)") ! 260: (make-local-variable 'comment-column) ! 261: (setq comment-column 39) ; Start of comment in this column ! 262: (make-local-variable 'comment-start-skip) ! 263: (setq comment-start-skip "(\\*+[ \t]?") ; This matches a start of comment ! 264: (make-local-variable 'comment-indent-hook) ! 265: (setq comment-indent-hook 'sml-comment-indent) ! 266: ;; ! 267: ;; Adding these will fool the matching of parens. I really don't ! 268: ;; know why. It would be nice to have comments treated as ! 269: ;; white-space ! 270: ;; ! 271: ;; (make-local-variable 'parse-sexp-ignore-comments) ! 272: ;; (setq parse-sexp-ignore-comments t) ! 273: ;; ! 274: (run-hooks 'sml-mode-hook)) ; Run the hook ! 275: ! 276: (defconst sml-pipe-matchers-reg ! 277: "\\bcase\\b\\|\\bfn\\b\\|\\bfun\\b\\|\\bhandle\\b\ ! 278: \\|\\bdatatype\\b\\|\\babstype\\b\\|\\band\\b" ! 279: "The keywords a `|' can follow.") ! 280: ! 281: (defun sml-electric-pipe () ! 282: "Insert a \"|\". Depending on the context insert the name of ! 283: function, a \"=>\" etc." ! 284: (interactive) ! 285: (let ((here (point)) ! 286: (match (save-excursion ! 287: (sml-find-matching-starter sml-pipe-matchers-reg) ! 288: (point))) ! 289: (tmp " => ") ! 290: (case-or-handle-exp t)) ! 291: (if (/= (save-excursion (beginning-of-line) (point)) ! 292: (save-excursion (skip-chars-backward "\t ") (point))) ! 293: (insert "\n")) ! 294: (insert "|") ! 295: (save-excursion ! 296: (goto-char match) ! 297: (cond ! 298: ;; It was a function, insert the function name ! 299: ((looking-at "fun\\b") ! 300: (setq tmp (concat " " (buffer-substring ! 301: (progn (forward-char 3) ! 302: (skip-chars-forward "\t\n ") (point)) ! 303: (progn (forward-word 1) (point))) " ")) ! 304: (setq case-or-handle-exp nil)) ! 305: ;; It was a datatype, insert nothing ! 306: ((looking-at "datatype\\b\\|abstype\\b") ! 307: (setq tmp " ") (setq case-or-handle-exp nil)) ! 308: ;; If is and, then we have to see what is was ! 309: ((looking-at "and\\b") ! 310: (let (isfun) ! 311: (save-excursion ! 312: (condition-case () ! 313: (progn ! 314: (re-search-backward "datatype\\b\\|abstype\\b\\|fun\\b") ! 315: (setq isfun (looking-at "fun\\b"))) ! 316: (error (setq isfun nil)))) ! 317: (if isfun ! 318: (progn ! 319: (setq tmp ! 320: (concat " " (buffer-substring ! 321: (progn (forward-char 3) ! 322: (skip-chars-forward "\t\n ") (point)) ! 323: (progn (forward-word 1) (point))) " ")) ! 324: (setq case-or-handle-exp nil)) ! 325: (setq tmp " ") (setq case-or-handle-exp nil)))))) ! 326: (insert tmp) ! 327: (sml-indent-line) ! 328: (beginning-of-line) ! 329: (skip-chars-forward "\t ") ! 330: (forward-char (1+ (length tmp))) ! 331: (if case-or-handle-exp ! 332: (forward-char -4)))) ! 333: ! 334: (defun sml-electric-semi () ! 335: "If sml-electric-semi-mode is t, indent the current line, and newline." ! 336: (interactive) ! 337: (insert "\;") ! 338: (if sml-electric-semi-mode ! 339: (reindent-then-newline-and-indent))) ! 340: ! 341: (defun sml-mode-version () ! 342: (interactive) ! 343: (message sml-mode-version-string)) ! 344: ! 345: ! 346: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ! 347: ;;; ! 348: ;;; SHORT CUTS (sml-region) ! 349: ;;; ! 350: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ! 351: ! 352: (defconst sml-region-alist ! 353: '(("let") ("local") ("signature") ("structure") ("datatype") ! 354: ("case") ("functor") ("abstype")) ! 355: "The list of regions to auto-insert.") ! 356: ! 357: (defun sml-region () ! 358: "Interactive short-cut. Insert a common used structure in sml." ! 359: (interactive) ! 360: (let ((newline nil) ; Did we insert a newline ! 361: (name (completing-read "Region to insert: (default let) " ! 362: sml-region-alist nil t nil))) ! 363: ;; default is "let" ! 364: (if (string= name "") (setq name "let")) ! 365: ;; Insert a newline if point is not at empty line ! 366: (sml-indent-line) ; Indent the current line ! 367: (if (save-excursion (beginning-of-line) (skip-chars-forward "\t ") (eolp)) ! 368: () ! 369: (setq newline t) ! 370: (insert "\n")) ! 371: (condition-case () ! 372: (cond ! 373: ((string= name "let") (sml-let)) ! 374: ((string= name "local") (sml-local)) ! 375: ((string= name "structure") (sml-structure)) ! 376: ((string= name "signature") (sml-signature)) ! 377: ((string= name "functor") (sml-functor)) ! 378: ((string= name "case") (sml-case)) ! 379: ((string= name "abstype") (sml-abstype)) ! 380: ((string= name "datatype") (sml-datatype))) ! 381: (quit (if newline ! 382: (progn ! 383: (delete-char -1) ! 384: (beep))))))) ! 385: ! 386: (defun sml-let () ! 387: "Insert a `let in end'." ! 388: (interactive) (sml-let-local "let")) ! 389: ! 390: (defun sml-local () ! 391: "Insert a `local in end'." ! 392: (interactive) (sml-let-local "local")) ! 393: ! 394: (defun sml-signature () ! 395: "Insert a `signature ??? = sig end', prompting for name." ! 396: (interactive) (sml-structure-signature "signature")) ! 397: ! 398: (defun sml-structure () ! 399: "Insert a `structure ??? = struct end', prompting for name." ! 400: (interactive) (sml-structure-signature "structure")) ! 401: ! 402: (defun sml-case () ! 403: "Insert a case, prompting for case-expresion." ! 404: (interactive) ! 405: (let (indent (expr (read-string "Case expr: "))) ! 406: (insert (concat "case " expr)) ! 407: (sml-indent-line) ! 408: (setq indent (current-indentation)) ! 409: (end-of-line) ! 410: (if sml-case-indent ! 411: (progn ! 412: (insert "\n") ! 413: (indent-to (+ 2 indent)) ! 414: (insert "of ")) ! 415: (insert " of\n") ! 416: (indent-to (+ indent sml-indent-level))) ! 417: (save-excursion (insert " => ")))) ! 418: ! 419: (defun sml-let-local (starter) ! 420: (let (indent) ! 421: (insert starter) ! 422: (sml-indent-line) ! 423: (setq indent (current-indentation)) ! 424: (end-of-line) ! 425: (insert "\n") (indent-to (+ sml-indent-level indent)) ! 426: (insert "\n") (indent-to indent) ! 427: (insert "in\n") (indent-to (+ sml-indent-level indent)) ! 428: (insert "\n") (indent-to indent) ! 429: (insert "end") (previous-line 3) (end-of-line))) ! 430: ! 431: (defun sml-structure-signature (which) ! 432: (let (indent ! 433: (name (read-string (concat "Name of " which ": ")))) ! 434: (insert (concat which " " name " =")) ! 435: (sml-indent-line) ! 436: (setq indent (current-indentation)) ! 437: (end-of-line) ! 438: (insert "\n") (indent-to (+ sml-indent-level indent)) ! 439: (insert (if (string= which "signature") "sig\n" "struct\n")) ! 440: (indent-to (+ (* 2 sml-indent-level) indent)) ! 441: (insert "\n") (indent-to (+ sml-indent-level indent)) ! 442: (insert "end") (previous-line 1) (end-of-line))) ! 443: ! 444: (defun sml-functor () ! 445: "Insert a `funtor ??? () : ??? = struct end', prompting for name and type." ! 446: (let (indent ! 447: (name (read-string "Name of functor: ")) ! 448: (signame (read-string "Signature type of functor: "))) ! 449: (insert (concat "functor " name " () : " signame " =")) ! 450: (sml-indent-line) ! 451: (setq indent (current-indentation)) ! 452: (end-of-line) ! 453: (insert "\n") (indent-to (+ sml-indent-level indent)) ! 454: (insert "struct\n") ! 455: (indent-to (+ (* 2 sml-indent-level) indent)) ! 456: (insert "\n") (indent-to (+ sml-indent-level indent)) ! 457: (insert "end") (previous-line 1) (end-of-line))) ! 458: ! 459: (defun sml-datatype () ! 460: "Insert a `datatype ??? =', prompting for name." ! 461: (let (indent ! 462: (type (read-string (concat "Type of datatype (default none): "))) ! 463: (name (read-string (concat "Name of datatype: ")))) ! 464: (insert (concat "datatype " ! 465: (if (string= type "") "" (concat type " ")) ! 466: name " =")) ! 467: (sml-indent-line) ! 468: (setq indent (current-indentation)) ! 469: (end-of-line) (insert "\n") (indent-to (+ sml-indent-level indent)))) ! 470: ! 471: (defun sml-abstype () ! 472: "Insert an `abstype 'a ??? = with ... end'" ! 473: (let (indent ! 474: (typevar (read-string "Name of typevariable (default 'a): ")) ! 475: (type (read-string "Name of abstype: "))) ! 476: (if (string= typevar "") ! 477: (setq typevar "'a")) ! 478: (insert (concat "abstype " typevar " " type " =")) ! 479: (sml-indent-line) ! 480: (setq indent (current-indentation)) ! 481: (insert "\n") (indent-to (+ sml-indent-level indent)) ! 482: (insert "\n") (indent-to indent) ! 483: (insert "with\n") (indent-to (+ sml-indent-level indent)) ! 484: (insert "\n") (indent-to indent) ! 485: (insert "end") ! 486: (previous-line 3) ! 487: (end-of-line))) ! 488: ! 489: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ! 490: ;;; ! 491: ;;; PARSING ERROR MESSAGES (NOTE: works only with SML of New Jersey) ! 492: ;;; ! 493: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ! 494: ! 495: (defvar sml-last-error 1 "Last position of error. Initially 1.") ! 496: ! 497: (defun sml-next-error () ! 498: "Find the next error by passing the *SML* buffer.\n ! 499: NOTE: This function only knows about the syntax of errors generated by ! 500: SML of New Jersey, and will only work with this." ! 501: (interactive) ! 502: (let ((found t) (tmp-file nil) found-line found-file error-line tmp) ! 503: (save-excursion ! 504: (condition-case () ! 505: (progn ! 506: (set-buffer (concat "*" sml-process-name "*" )) ! 507: (goto-char sml-last-error) ! 508: (re-search-forward "^.+line.+\\(Error:\\|Warning:\\)") ! 509: (save-excursion ! 510: (beginning-of-line) ! 511: (if (looking-at sml-tmp-template) ! 512: (setq tmp-file t))) ! 513: (setq sml-last-error (point)) ! 514: (beginning-of-line) ! 515: (setq error-line (point)) ! 516: (search-forward ",") ! 517: (setq found-file (buffer-substring error-line (1- (point)))) ! 518: (search-forward "line ") ! 519: (setq tmp (point)) ! 520: (skip-chars-forward "[0-9]") ! 521: (setq found-line (string-to-int (buffer-substring tmp (point))))) ! 522: (error (setq found nil)))) ! 523: (if found ! 524: (progn ! 525: (set-window-start ! 526: (display-buffer (concat "*" sml-process-name "*")) error-line) ! 527: (if tmp-file ! 528: (let ((loop t) (n 0) (tmp-list sml-tmp-files-list)) ! 529: (while loop ! 530: (setq tmp (car tmp-list)) ! 531: (if (string= (car tmp) found-file) ! 532: (setq loop nil) ! 533: (setq tmp-list (cdr tmp-list))) ! 534: (if (null tmp-list) (setq loop nil))) ! 535: (if (null tmp) ! 536: (error "Temporary file not associated with buffer.") ! 537: (condition-case () ! 538: (progn ! 539: (switch-to-buffer (nth 1 tmp)) ! 540: (message ! 541: (concat "Error found in temporary file " ! 542: "(line number may not match).")) ! 543: (goto-line (1- (+ found-line (nth 2 tmp))))) ! 544: (error (error "Sorry, buffer doesn't exist any more."))))) ! 545: (if (file-exists-p found-file) ! 546: (progn ! 547: (condition-case () ! 548: (progn ! 549: (find-file found-file) ! 550: (goto-line found-line)) ! 551: (error ()))) ! 552: (error (concat "File not found: " found-file))))) ! 553: ;; No error found ! 554: (if (= sml-last-error 1) ; Did we just start ! 555: (message "No errors yet") ! 556: (message "No more errors")) ; Or have we passed all errors ! 557: (beep)))) ! 558: ! 559: (defun sml-skip-errors () ! 560: "Skip past the rest of the errors." ! 561: (interactive) ! 562: (save-excursion ! 563: (set-buffer (concat "*" sml-process-name "*" )) ! 564: (setq sml-last-error (point-max)))) ! 565: ! 566: ! 567: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ! 568: ;;; ! 569: ;;; INDENTATION ! 570: ;;; ! 571: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ! 572: ! 573: (defun sml-indent-region (begin end) ! 574: "Indent region of sml code." ! 575: (interactive "r") ! 576: (message "Indenting region...") ! 577: (save-excursion ! 578: (goto-char end) (setq end (point-marker)) (goto-char begin) ! 579: (while (< (point) end) ! 580: (skip-chars-forward "\t\n ") ! 581: (sml-indent-line) ! 582: (end-of-line)) ! 583: (move-marker end nil)) ! 584: (message "Indenting region... done")) ! 585: ! 586: (defun sml-indent-line () ! 587: "Indent current line of sml code." ! 588: (interactive) ! 589: (let ((indent (sml-calculate-indentation))) ! 590: (if (/= (current-indentation) indent) ! 591: (save-excursion ;; Added 890601 (point now stays) ! 592: (let ((beg (progn (beginning-of-line) (point)))) ! 593: (skip-chars-forward "\t ") ! 594: (delete-region beg (point)) ! 595: (indent-to indent)))) ! 596: ;; If point is before indentation, move point to indentation ! 597: (if (< (current-column) (current-indentation)) ! 598: (skip-chars-forward "\t ")))) ! 599: ! 600: (defconst sml-indent-starters-reg ! 601: "abstraction\\b\\|abstype\\b\\|and\\b\\|case\\b\\|datatype\\b\ ! 602: \\|else\\b\\|fun\\b\\|functor\\b\\|if\\b\\|sharing\\b\ ! 603: \\|in\\b\\|infix\\b\\|infixr\\b\\|let\\b\\|local\\b\ ! 604: \\|nonfix\\b\\|of\\b\\|open\\b\\|raise\\b\\|sig\\b\\|signature\\b\ ! 605: \\|struct\\b\\|structure\\b\\|then\\b\\|\\btype\\b\\|val\\b\ ! 606: \\|while\\b\\|with\\b\\|withtype\\b" ! 607: "The indentation starters. The next line, after one starting with ! 608: one of these, will be indented.") ! 609: ! 610: (defconst sml-starters-reg ! 611: "\\babstraction\\b\\|\\babstype\\b\\|\\bdatatype\\b\ ! 612: \\|\\bexception\\b\\|\\bfun\\b\\|\\bfunctor\\b\\|\\blocal\\b\ ! 613: \\|\\binfix\\b\\|\\binfixr\\b\\|sharing\\b\ ! 614: \\|\\bnonfix\\b\\|\\bopen\\b\\|\\bsignature\\b\\|\\bstructure\\b\ ! 615: \\|\\btype\\b\\|\\bval\\b\\|\\bwithtype\\b\\|\\bwith\\b" ! 616: "The starters of new expressions.") ! 617: ! 618: (defconst sml-end-starters-reg ! 619: "\\blet\\b\\|\\blocal\\b\\|\\bsig\\b\\|\\bstruct\\b\\|\\bwith\\b" ! 620: "Matching reg-expression for the \"end\" keyword.") ! 621: ! 622: (defconst sml-starters-indent-after ! 623: "let\\b\\|local\\b\\|struct\\b\\|in\\b\\|sig\\b\\|with\\b" ! 624: "Indent after these.") ! 625: ! 626: (defun sml-calculate-indentation () ! 627: (save-excursion ! 628: (beginning-of-line) ; Go to first non whitespace ! 629: (skip-chars-forward "\t ") ; on the line. ! 630: (cond ! 631: ;; Indentation for comments alone on a line, matches the ! 632: ;; proper indentation of the next line. Search only for the ! 633: ;; next "*)", not for the matching. ! 634: ((looking-at "(\\*") ! 635: (if (not (search-forward "*)" nil t)) ! 636: (error "Comment not ended.")) ! 637: (skip-chars-forward "\n\t ") ! 638: ;; If we are at eob, just indent 0 ! 639: (if (eobp) 0 (sml-calculate-indentation))) ! 640: ;; Are we looking at a case expression ? ! 641: ((looking-at "|.*=>") ! 642: (sml-skip-block) ! 643: ;; Dont get fooled by fn _ => in case statements (890726) ! 644: (sml-re-search-backward "=>") ! 645: (let ((loop t)) ! 646: (while (and loop (save-excursion ! 647: (beginning-of-line) ! 648: (looking-at ".*\\bfn\\b.*=>"))) ! 649: (setq loop (sml-re-search-backward "=>")))) ! 650: (beginning-of-line) ! 651: (skip-chars-forward "\t ") ! 652: (cond ! 653: ((looking-at "|") (current-indentation)) ! 654: ((and sml-case-indent (looking-at "of\\b")) ! 655: (1+ (current-indentation))) ! 656: ((looking-at "fn\\b") (1+ (current-indentation))) ! 657: ((looking-at "handle\\b") (+ (current-indentation) 5)) ! 658: (t (+ (current-indentation) sml-pipe-indent)))) ! 659: ((looking-at "and\\b") ! 660: (if (sml-find-matching-starter sml-starters-reg) ! 661: (current-column) ! 662: 0)) ! 663: ((looking-at "in\\b") ; Match the beginning let/local ! 664: (sml-find-match-indent "in" "\\bin\\b" "\\blocal\\b\\|\\blet\\b")) ! 665: ((looking-at "end\\b") ; Match the beginning ! 666: (sml-find-match-indent "end" "\\bend\\b" sml-end-starters-reg)) ! 667: ((and sml-nested-if-indent (looking-at "else[\t ]*if\\b")) ! 668: (sml-re-search-backward "\\bif\\b\\|\\belse\\b") ! 669: (current-indentation)) ! 670: ((looking-at "else\\b") ; Match the if ! 671: (sml-find-match-indent "else" "\\belse\\b" "\\bif\\b" t)) ! 672: ((looking-at "then\\b") ; Match the if + extra indentation ! 673: (+ (sml-find-match-indent "then" "\\bthen\\b" "\\bif\\b" t) ! 674: sml-indent-level)) ! 675: ((and sml-case-indent (looking-at "of\\b")) ! 676: (sml-re-search-backward "\\bcase\\b") ! 677: (+ (current-column) 2)) ! 678: ((looking-at sml-starters-reg) ! 679: (let ((start (point))) ! 680: (sml-backward-sexp) ! 681: (if (and (looking-at sml-starters-indent-after) ! 682: (/= start (point))) ! 683: (+ (if sml-type-of-indent ! 684: (current-column) ! 685: (if (progn (beginning-of-line) ! 686: (skip-chars-forward "\t ") ! 687: (looking-at "|")) ! 688: (- (current-indentation) sml-pipe-indent) ! 689: (current-indentation))) ! 690: sml-indent-level) ! 691: (beginning-of-line) ! 692: (skip-chars-forward "\t ") ! 693: (if (and (looking-at sml-starters-indent-after) ! 694: (/= start (point))) ! 695: (+ (if sml-type-of-indent ! 696: (current-column) ! 697: (current-indentation)) ! 698: sml-indent-level) ! 699: (goto-char start) ! 700: (if (sml-find-matching-starter sml-starters-reg) ! 701: (current-column) ! 702: 0))))) ! 703: (t ! 704: (let ((indent (sml-get-indent))) ! 705: (cond ! 706: ((looking-at "|") ! 707: ;; Lets see if it is the follower of a function definition ! 708: (if (sml-find-matching-starter ! 709: "\\bfun\\b\\|\\bfn\\b\\|\\band\\b\\|\\bhandle\\b") ! 710: (cond ! 711: ((looking-at "fun\\b") (- (current-column) sml-pipe-indent)) ! 712: ((looking-at "fn\\b") (1+ (current-column))) ! 713: ((looking-at "and\\b") (1+ (1+ (current-column)))) ! 714: ((looking-at "handle\\b") (+ (current-column) 5))) ! 715: (+ indent sml-pipe-indent))) ! 716: (t ! 717: (if sml-paren-lookback ; Look for open parenthesis ? ! 718: (max indent (sml-get-paren-indent)) ! 719: indent)))))))) ! 720: ! 721: (defun sml-get-indent () ! 722: (save-excursion ! 723: (beginning-of-line) ! 724: (skip-chars-backward "\t\n; ") ! 725: (if (looking-at ";") (sml-backward-sexp)) ! 726: (cond ! 727: ((save-excursion (sml-backward-sexp) (looking-at "end\\b")) ! 728: (- (current-indentation) sml-indent-level)) ! 729: (t ! 730: (while (/= (current-column) (current-indentation)) ! 731: (sml-backward-sexp)) ! 732: (skip-chars-forward "\t |") ! 733: (let ((indent (current-column))) ! 734: (skip-chars-forward "\t (") ! 735: (cond ! 736: ;; Started val/fun/structure... ! 737: ((looking-at sml-indent-starters-reg) ! 738: (+ (current-column) sml-indent-level)) ! 739: ;; Indent after "=>" pattern, but only if its not an fn _ => ! 740: ;; (890726) ! 741: ((looking-at ".*=>") ! 742: (if (looking-at ".*\\bfn\\b.*=>") ! 743: indent ! 744: (+ indent sml-indent-level))) ! 745: ;; else keep the same indentation as previous line ! 746: (t indent))))))) ! 747: ! 748: (defun sml-get-paren-indent () ! 749: (save-excursion ! 750: (let ((levelpar 0) ; Level of "()" ! 751: (levelcurl 0) ; Level of "{}" ! 752: (levelsqr 0) ; Level of "[]" ! 753: (backpoint (max (- (point) sml-paren-lookback) (point-min))) ! 754: (loop t)) ! 755: (while (and (/= levelpar 1) (/= levelsqr 1) (/= levelcurl 1) loop) ! 756: (if (re-search-backward "[][{}()]" backpoint t) ! 757: (if (not (sml-inside-comment-or-string-p)) ! 758: (cond ! 759: ((looking-at "(") (setq levelpar (1+ levelpar))) ! 760: ((looking-at ")") (setq levelpar (1- levelpar))) ! 761: ((looking-at "\\[") (setq levelsqr (1+ levelsqr))) ! 762: ((looking-at "\\]") (setq levelsqr (1- levelsqr))) ! 763: ((looking-at "{") (setq levelcurl (1+ levelcurl))) ! 764: ((looking-at "}") (setq levelcurl (1- levelcurl))))) ! 765: (setq loop nil))) ! 766: (if loop ! 767: (1+ (current-column)) ! 768: 0)))) ! 769: ! 770: (defun sml-inside-comment-or-string-p () ! 771: (let ((start (point))) ! 772: (if (save-excursion ! 773: (condition-case () ! 774: (progn ! 775: (search-backward "(*") ! 776: (search-forward "*)") ! 777: (forward-char -1) ; A "*)" is not inside the comment ! 778: (> (point) start)) ! 779: (error nil))) ! 780: t ! 781: (let ((numb 0)) ! 782: (save-excursion ! 783: (save-restriction ! 784: (narrow-to-region (progn (beginning-of-line) (point)) start) ! 785: (condition-case () ! 786: (while t ! 787: (search-forward "\"") ! 788: (setq numb (1+ numb))) ! 789: (error (if (and (not (zerop numb)) ! 790: (not (zerop (% numb 2)))) ! 791: t nil))))))))) ! 792: ! 793: (defun sml-skip-block () ! 794: (sml-backward-sexp) ! 795: (if (looking-at "end\\b") ! 796: (progn ! 797: (goto-char (sml-find-match-backward "end" "\\bend\\b" ! 798: sml-end-starters-reg)) ! 799: (skip-chars-backward "\n\t ")) ! 800: ;; Here we will need to skip backward past if-then-else ! 801: ;; and case-of expression. Please - tell me how !! ! 802: )) ! 803: ! 804: (defun sml-find-match-backward (unquoted-this this match &optional start) ! 805: (save-excursion ! 806: (let ((level 1) ! 807: (pattern (concat this "\\|" match))) ! 808: (if start (goto-char start)) ! 809: (while (not (zerop level)) ! 810: (if (sml-re-search-backward pattern) ! 811: (setq level (cond ! 812: ((looking-at this) (1+ level)) ! 813: ((looking-at match) (1- level)))) ! 814: ;; The right match couldn't be found ! 815: (error (concat "Unbalanced: " unquoted-this)))) ! 816: (point)))) ! 817: ! 818: (defun sml-find-match-indent (unquoted-this this match &optional indented) ! 819: (save-excursion ! 820: (goto-char (sml-find-match-backward unquoted-this this match)) ! 821: (if (or sml-type-of-indent indented) ! 822: (current-column) ! 823: (if (progn ! 824: (beginning-of-line) ! 825: (skip-chars-forward "\t ") ! 826: (looking-at "|")) ! 827: (- (current-indentation) sml-pipe-indent) ! 828: (current-indentation))))) ! 829: ! 830: (defun sml-find-matching-starter (regexp) ! 831: (let ((start-let-point (sml-point-inside-let-etc)) ! 832: (start-up-list (sml-up-list)) ! 833: (found t)) ! 834: (if (sml-re-search-backward regexp) ! 835: (progn ! 836: (condition-case () ! 837: (while (or (/= start-up-list (sml-up-list)) ! 838: (/= start-let-point (sml-point-inside-let-etc))) ! 839: (re-search-backward regexp)) ! 840: (error (setq found nil))) ! 841: found) ! 842: nil))) ! 843: ! 844: (defun sml-point-inside-let-etc () ! 845: (let ((last nil) (loop t) (found t) (start (point))) ! 846: (save-excursion ! 847: (while loop ! 848: (condition-case () ! 849: (progn ! 850: (re-search-forward "\\bend\\b") ! 851: (while (sml-inside-comment-or-string-p) ! 852: (re-search-forward "\\bend\\b")) ! 853: (forward-char -3) ! 854: (setq last (sml-find-match-backward "end" "\\bend\\b" ! 855: sml-end-starters-reg last)) ! 856: (if (< last start) ! 857: (setq loop nil) ! 858: (forward-char 3))) ! 859: (error (progn (setq found nil) (setq loop nil))))) ! 860: (if found ! 861: last ! 862: 0)))) ! 863: ! 864: (defun sml-re-search-backward (regexpr) ! 865: (let ((found t)) ! 866: (if (re-search-backward regexpr nil t) ! 867: (progn ! 868: (condition-case () ! 869: (while (sml-inside-comment-or-string-p) ! 870: (re-search-backward regexpr)) ! 871: (error (setq found nil))) ! 872: found) ! 873: nil))) ! 874: ! 875: (defun sml-up-list () ! 876: (save-excursion ! 877: (condition-case () ! 878: (progn ! 879: (up-list 1) ! 880: (point)) ! 881: (error 0)))) ! 882: ! 883: (defun sml-backward-sexp () ! 884: (condition-case () ! 885: (progn ! 886: (let ((start (point))) ! 887: (backward-sexp 1) ! 888: (while (and (/= start (point)) (looking-at "(\\*")) ! 889: (setq start (point)) ! 890: (backward-sexp 1)))) ! 891: (error (forward-char -1)))) ! 892: ! 893: (defun sml-comment-indent () ! 894: (if (looking-at "^(\\*") ; Existing comment at beginning ! 895: 0 ; of line stays there. ! 896: (save-excursion ! 897: (skip-chars-backward " \t") ! 898: (1+ (max (current-column) ; Else indent at comment column ! 899: comment-column))))) ; except leave at least one space. ! 900: ! 901: ! 902: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ! 903: ;;; ! 904: ;;; INFERIOR SHELL ! 905: ;;; ! 906: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ! 907: ! 908: (defvar sml-shell-map nil "The mode map for sml-shell.") ! 909: ! 910: (defun sml-shell () ! 911: "Inferior shell invoking SML. ! 912: It is not possible to have more than one shell running SML. ! 913: Like the shell mode with the additional command: ! 914: ! 915: \\[sml-run-on-file]\t Runs sml on the file. ! 916: \\{sml-shell-map} ! 917: Variables controlling the mode: ! 918: ! 919: sml-prog-name (default \"sml\") ! 920: The string used to invoke the sml program. ! 921: ! 922: sml-prog-name-ask-p (default nil) ! 923: If t, you will be asked which program to run when the inferior ! 924: shell starts up. Usefull if you have exported images of sml. ! 925: ! 926: sml-use-right-delim (default \"\\\"\") ! 927: sml-use-left-delim (default \"\\\"\") ! 928: The left and right delimiter used by your version of sml, for ! 929: \"use file-name\". ! 930: ! 931: sml-process-name (default \"SML\") ! 932: The name of the process running sml. ! 933: ! 934: sml-shell-prompt-pattern (default \"^[^\\-=]*[\\-=] *\") ! 935: The prompt pattern. ! 936: ! 937: Runs sml-shell-hook if not nil." ! 938: (interactive) ! 939: (if (not (process-status sml-process-name)) ! 940: (save-excursion ; Process is not running ! 941: (and sml-prog-name-ask-p ! 942: (setq sml-prog-name ! 943: (read-file-name ! 944: (concat "Sml (default " sml-prog-name "): ") ! 945: (file-name-directory (buffer-file-name)) ! 946: sml-prog-name))) ! 947: (message "Starting SML...") ; start up a new process ! 948: (require 'shell) ! 949: (set-buffer ! 950: (make-shell sml-process-name ! 951: (if (= (string-to-char sml-prog-name) ?~) ! 952: (expand-file-name sml-prog-name) ! 953: sml-prog-name))) ! 954: (erase-buffer) ; Erase the buffer if a previous ! 955: (if sml-shell-map ; process died in there ! 956: () ! 957: (setq sml-shell-map (copy-sequence shell-mode-map)) ! 958: (define-key sml-shell-map "\C-c\C-f" 'sml-run-on-file)) ! 959: (use-local-map sml-shell-map) ! 960: (make-local-variable 'shell-prompt-pattern) ! 961: (setq shell-prompt-pattern sml-shell-prompt-pattern) ! 962: (setq major-mode 'sml-shell) ! 963: (setq mode-name "Sml-Shell") ! 964: (if sml-prog-name-ask-p ! 965: (setq mode-line-process ! 966: (list (concat ! 967: ": %s (" ! 968: (substring sml-prog-name ! 969: (string-match "[^/]*$" sml-prog-name) ! 970: (string-match "$" sml-prog-name)) ! 971: ")")))) ! 972: (set-process-filter (get-process sml-process-name) 'sml-process-filter) ! 973: (message "Starting SML... done.") ! 974: (run-hooks 'sml-shell-hook)))) ! 975: ! 976: (defun sml-process-filter (proc str) ! 977: (let ((cur (selected-window)) ! 978: (pop-up-windows t) ! 979: (process (concat "*" sml-process-name "*"))) ! 980: (pop-to-buffer process) ! 981: (goto-char (point-max)) ! 982: (insert str) ! 983: (set-marker (process-mark proc) (point-max)) ! 984: (select-window cur))) ! 985: ! 986: (defun sml-pop-to-shell () ! 987: "Pop to the buffer running SML" ! 988: (interactive) ! 989: (sml-shell) ! 990: (pop-to-buffer (concat "*" sml-process-name "*"))) ! 991: ! 992: (defun sml-run-on-file (fil) ! 993: "Send a use FILE to the inferior shell running sml" ! 994: (interactive "FUse file: ") ! 995: (sml-shell) ! 996: (save-some-buffers) ! 997: (sml-skip-errors) ! 998: (send-string sml-process-name ! 999: (concat "use " sml-use-left-delim (expand-file-name fil) ! 1000: sml-use-right-delim ";\n"))) ! 1001: ! 1002: (defun sml-save-buffer-use-file () ! 1003: "Save the buffer, and send a `use file' to the inferior shell ! 1004: running SML." ! 1005: (interactive) ! 1006: (let (file) ! 1007: (if (setq file (buffer-file-name)) ; Is the buffer associated ! 1008: (progn ; with file ? ! 1009: (save-buffer) ! 1010: (sml-shell) ! 1011: (sml-skip-errors) ! 1012: (message (concat "use " sml-use-left-delim file sml-use-right-delim)) ! 1013: (send-string sml-process-name ! 1014: (concat "use " sml-use-left-delim ! 1015: (expand-file-name file) ! 1016: sml-use-right-delim ";\n"))) ! 1017: (error "Buffer not associated with file.")))) ! 1018: ! 1019: (defun sml-import-file () ! 1020: "Save the buffer, and send an `import file' to the inferior shell ! 1021: running SML." ! 1022: (interactive) ! 1023: (let (file) ! 1024: (if (setq file (buffer-file-name)) ! 1025: (if (string-match ".sml$" file) ! 1026: (progn ! 1027: (setq file (substring file 0 (string-match ".sml$" file))) ! 1028: (save-buffer) ! 1029: (sml-shell) ! 1030: (sml-skip-errors) ! 1031: (message (concat "import \"" file "\"")) ! 1032: (send-string sml-process-name ! 1033: (concat "import " sml-use-left-delim ! 1034: (expand-file-name file) ! 1035: sml-use-right-delim ";\n"))) ! 1036: (error "Filename doesn't match \"*.sml\"")) ! 1037: (error "Buffer not associated with file.")))) ! 1038: ! 1039: (defvar sml-tmp-files-list nil ! 1040: "List of all temporary files created by sml-simulate-send-region. ! 1041: Each element in the list is a list with the format: ! 1042: \n (\"tmp-filename\" buffer start-line)") ! 1043: ! 1044: (defvar sml-simulate-send-region-called-p nil ! 1045: "Has sml-simulate-send-region been called previously.") ! 1046: ! 1047: (defun sml-simulate-send-region (point1 point2) ! 1048: "Simulate send region. As send-region only can handle what ever the ! 1049: system sets as the default, we have to make a temporary file. ! 1050: Updates the list of temporary files (sml-tmp-files-list)." ! 1051: (let ((file (expand-file-name (make-temp-name sml-tmp-template)))) ! 1052: ;; Remove temporary files when we leave emacs ! 1053: (if (not sml-simulate-send-region-called-p) ! 1054: (progn ! 1055: (setq sml-old-kill-emacs-hook kill-emacs-hook) ! 1056: (setq kill-emacs-hook 'sml-remove-tmp-files) ! 1057: (setq sml-simulate-send-region-called-p t))) ! 1058: ;; As make-temp-name can only make 26 unique file names with the ! 1059: ;; same template (bug in Un*x function mktemp), we add a new ! 1060: ;; letter to sml-tmp-template. ! 1061: (if (zerop (% (length sml-tmp-files-list) 25)) ! 1062: (setq sml-tmp-template (concat sml-tmp-template "A"))) ! 1063: (save-excursion ! 1064: (goto-char point1) ! 1065: (setq sml-tmp-files-list ! 1066: (cons (list file ! 1067: (current-buffer) ! 1068: (save-excursion ; Calculate line no. ! 1069: (beginning-of-line) ! 1070: (1+ (count-lines 1 (point))))) ! 1071: sml-tmp-files-list))) ! 1072: (write-region point1 point2 file nil 'dummy) ! 1073: (sml-shell) ! 1074: (message "Using temporary file: %s" file) ! 1075: (send-string ! 1076: sml-process-name ! 1077: ;; string to send: use file; ! 1078: (concat "use " sml-use-left-delim file sml-use-right-delim ";\n")))) ! 1079: ! 1080: (defvar sml-old-kill-emacs-hook nil ! 1081: "Old value of kill-emacs-hook") ! 1082: ! 1083: (defun sml-remove-tmp-files () ! 1084: "Remove the temporary files, created by sml-simulate-send-region, if ! 1085: they still exist. Only files recorded in sml-tmp-files-list are removed." ! 1086: (message "Removing temporary files created by sml-mode...") ! 1087: (while sml-tmp-files-list ! 1088: (condition-case () ! 1089: (delete-file (car (car sml-tmp-files-list))) ! 1090: (error ())) ! 1091: (setq sml-tmp-files-list (cdr sml-tmp-files-list))) ! 1092: (message "Removing temporary files created by sml-mode... done.") ! 1093: (run-hooks 'sml-old-kill-emacs-hook)) ! 1094: ! 1095: (defun sml-send-region () ! 1096: "Send region to inferior shell running SML." ! 1097: (interactive) ! 1098: (sml-shell) ! 1099: (sml-skip-errors) ! 1100: (let (start end) ! 1101: (save-excursion ! 1102: (setq end (point)) ! 1103: (exchange-point-and-mark) ! 1104: (setq start (point))) ! 1105: (sml-simulate-send-region start end))) ! 1106: ! 1107: (defun sml-send-function () ! 1108: "Does NOT send the function, but the paragraph, to inferior shell ! 1109: running SML" ! 1110: (interactive) ! 1111: (sml-shell) ! 1112: (sml-skip-errors) ! 1113: (let (start end) ! 1114: (save-excursion ! 1115: (condition-case () ! 1116: (progn ! 1117: (backward-paragraph) ! 1118: (setq start (point))) ! 1119: (error (setq start (point-min)))) ! 1120: (condition-case () ! 1121: (progn ! 1122: (forward-paragraph) ! 1123: (setq end (point))) ! 1124: (error (setq end (point-max))))) ! 1125: (sml-simulate-send-region start end))) ! 1126: ! 1127: (defun sml-send-buffer () ! 1128: "Send the buffer, to inferior shell running SML" ! 1129: (interactive) ! 1130: (sml-shell) ! 1131: (sml-skip-errors) ! 1132: (sml-simulate-send-region (point-min) (point-max))) ! 1133: ! 1134: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ! 1135: ;;; ! 1136: ;;; END OF SML-MODE ! 1137: ;;; ! 1138: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ! 1139:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.