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-proc.el
ViewVC logotype

Diff of /sml/trunk/sml-mode/sml-proc.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 378, Wed Jul 7 14:45:42 1999 UTC revision 394, Mon Aug 9 21:45:51 1999 UTC
# Line 38  Line 38 
38  ;; Inferior-sml-mode is for interacting with an ML process run under  ;; Inferior-sml-mode is for interacting with an ML process run under
39  ;; emacs. This uses the comint package so you get history, expansion,  ;; emacs. This uses the comint package so you get history, expansion,
40  ;; backup and all the other benefits of comint. Interaction is  ;; backup and all the other benefits of comint. Interaction is
41  ;; achieved by M-x sml which starts a sub-process under emacs. You may  ;; achieved by M-x run-sml which starts a sub-process under emacs. You may
42  ;; need to set this up for autoloading in your .emacs:  ;; need to set this up for autoloading in your .emacs:
43    
44  ;; (autoload 'sml "sml-proc" "Run an inferior ML process." t)  ;; (autoload 'run-sml "sml-proc" "Run an inferior ML process." t)
45    
46  ;; Exactly what process is governed by the variable sml-program-name  ;; Exactly what process is governed by the variable sml-program-name
47  ;; -- just "sml" by default. If you give a prefix argument (C-u M-x  ;; -- just "sml" by default. If you give a prefix argument (C-u M-x
48  ;; sml) you will be prompted for a different program to execute from  ;; run-sml) you will be prompted for a different program to execute from
49  ;; the default -- if you just hit RETURN you get the default anyway --  ;; the default -- if you just hit RETURN you get the default anyway --
50  ;; along with the option to specify any command line arguments. Once  ;; along with the option to specify any command line arguments. Once
51  ;; you select the ML program name in this manner, it remains the  ;; you select the ML program name in this manner, it remains the
# Line 66  Line 66 
66  ;; region of text to the ML process, etc. Given a prefix argument to  ;; region of text to the ML process, etc. Given a prefix argument to
67  ;; these commands will switch you from the SML buffer to the ML  ;; these commands will switch you from the SML buffer to the ML
68  ;; process buffer as well as sending the text. If you get errors  ;; process buffer as well as sending the text. If you get errors
69  ;; reported by the compiler, C-c ` (sml-next-error) will step through  ;; reported by the compiler, C-x ` (next-error) will step through
70  ;; the errors with you.  ;; the errors with you.
71    
72  ;; NOTE. There is only limited support for this as it obviously  ;; NOTE. There is only limited support for this as it obviously
73  ;; depends on the compiler's error messages being recognised by the  ;; depends on the compiler's error messages being recognised by the
74  ;; mode. Error reporting is currently only geared up for SML/NJ,  ;; mode. Error reporting is currently only geared up for SML/NJ,
75  ;; Moscow ML, and Poly/ML (see file sml-{mosml,poly-ml}.el). Look at  ;; Moscow ML, and Poly/ML.  For other compilers, add the relevant
76  ;; the documentation for sml-error-parser and sml-next-error -- you  ;; regexp to sml-error-regexp-alist and send it to me.
77  ;; may only need to modify the former to recover this feature for some  
78  ;; other ML systems, along with sml-error-regexp.  ;; To send pieces of code to the underlying compiler, we never send the text
79    ;; directly but use a temporary file instead.  This breaks if the compiler
80  ;; While small pieces of text can be fed quite happily into the ML  ;; does not understand `use', but has the benefit of allowing better error
81  ;; process directly, lager pieces should (probably) be sent via a  ;; reporting.
 ;; temporary file making use of the compiler's "use" command.  
 ;; To be safe, we always use a temp file (which also improves error  
 ;; reporting).  
   
 ;;; FOR YOUR .EMACS  
   
 ;; Here  are some ideas for inferior-sml-*-hooks:  
   
 ;; (setq inferior-sml-load-hook  
 ;;       '(lambda() "Set global defaults for inferior-sml-mode"  
 ;;          (define-key inferior-sml-mode-map "\C-cd"    'sml-cd)  
 ;;          (define-key          sml-mode-map "\C-cd"    'sml-cd)  
 ;;          (define-key          sml-mode-map "\C-c\C-f" 'sml-send-function)  
   
 ;; (setq inferior-sml-mode-hook  
 ;;       '(lambda() "Inferior SML mode defaults"  
 ;;          (setq comint-scroll-show-maximum-output t  
 ;;                comint-scroll-to-bottom-on-output t  
 ;;                comint-input-autoexpand nil)))  
82    
83  ;; ===================================================================  ;; ===================================================================
84    
# Line 108  Line 89 
89  (require 'comint)  (require 'comint)
90  (require 'compile)  (require 'compile)
91    
92  (defvar sml-program-name "sml"  (defgroup sml-proc ()
93    "*Program to run as ML.")    "Interacting with an SML process."
94      :group 'sml)
95  (defvar sml-default-arg ""  
96    "*Default command line option to pass, if any.")  (defcustom sml-program-name "sml"
97      "*Program to run as ML."
98      :group 'sml-proc
99      :type '(string))
100    
101    (defcustom sml-default-arg ""
102      "*Default command line option to pass, if any."
103      :group 'sml-proc
104      :type '(string))
105    
106  (defvar sml-compile-command "CM.make()"  (defvar sml-compile-command "CM.make()"
107    "The command used by default by `sml-make'.")    "The command used by default by `sml-make'.")
# Line 195  Line 184 
184  The format specifier \"%s\" will be converted into the directory name  The format specifier \"%s\" will be converted into the directory name
185  specified when running the command \\[sml-cd].")  specified when running the command \\[sml-cd].")
186    
187  (defvar sml-prompt-regexp "^[-=>#] *"  (defcustom sml-prompt-regexp "^[-=>#] *"
188    "*Regexp used to recognise prompts in the inferior ML process.")    "*Regexp used to recognise prompts in the inferior ML process."
189      :group 'sml-proc
190  (defvar sml-error-parser 'sml-smlnj-error-parser    :type '(regexp))
   "*This function parses an error message into a 3-5 element list:  
   
     \(file start-line start-col end-line-col err-msg\).  
   
 The first three components are required by `sml-next-error', but the other  
 two are optional. If the file associated with the input is the standard  
 input stream, this function should probably return  
   
     \(\"std_in\" start-line start-col\).  
   
 This function will be called in a context in which the match data \(see  
 `match-data'\) are current for `sml-error-regexp'. The mode sets the  
 default value to the function `sml-smlnj-error-parser'.  
   
 In a step towards greater sml-mode modularity END-LINE-COL can be either  
   
   - the symbol nil \(in which case it is ignored\)  
   
 or  
   
   - an Emacs Lisp expression that when `eval'd at \(start-line,start-col\)  
     will move point to the end of the errorful text in the file.  
   
 Note that the compiler should return the full path name of the errorful  
 file, and that this might require you to fiddle with the compiler's  
 prettyprinting switches.")  
   
 ;; std_in:2.1-4.3 Error: operator and operand don't agree (tycon mismatch)  
 ;; std_in:2.1 Error: operator and operand don't agree (tycon mismatch)  
191    
192  (defconst sml-error-regexp-alist  (defconst sml-error-regexp-alist
193    '(;; Poly/ML messages    '(;; Poly/ML messages
# Line 240  Line 200 
200      ;; SML/NJ's exceptions:  see above.      ;; SML/NJ's exceptions:  see above.
201      ("^ +\\(raised at: \\)?\\(.+\\):\\([0-9]+\\)\\.\\([0-9]+\\)\\(-\\([0-9]+\\)\\.\\([0-9]+\\)\\)" 2 sml-make-error 3 4 6 7)))      ("^ +\\(raised at: \\)?\\(.+\\):\\([0-9]+\\)\\.\\([0-9]+\\)\\(-\\([0-9]+\\)\\.\\([0-9]+\\)\\)" 2 sml-make-error 3 4 6 7)))
202    
 (defvar sml-error-regexp nil  
   "*Regexp for matching \(the start of\) an error message.")  
   
203  ;; font-lock support  ;; font-lock support
204  (defconst inferior-sml-font-lock-keywords  (defconst inferior-sml-font-lock-keywords
205    `(;; prompt and following interactive command    `(;; prompt and following interactive command
# Line 258  Line 215 
215                sml-error-regexp-alist))                sml-error-regexp-alist))
216    "Font-locking specification for inferior SML mode.")    "Font-locking specification for inferior SML mode.")
217    
218  ;; default faces values  (defface font-lock-prompt-face
219  (defvar font-lock-prompt-face    '((t (:bold t)))
220    (if (facep 'font-lock-prompt-face)    "Font Lock mode face used to highlight prompts."
221        'font-lock-prompt-face    :group 'font-lock-highlighting-faces)
222      'font-lock-keyword-face))  (defvar font-lock-prompt-face 'font-lock-prompt-face
223  (defvar font-lock-command-face    "Face name to use for prompts.")
224    (if (facep 'font-lock-command-face)  
225        'font-lock-command-face  (defface font-lock-command-face
226      'font-lock-function-name-face))    '((t (:bold t)))
227      "Font Lock mode face used to highlight interactive commands."
228      :group 'font-lock-highlighting-faces)
229    (defvar font-lock-command-face 'font-lock-command-face
230      "Face name to use for interactive commands.")
231    
232  (defvar inferior-sml-font-lock-defaults  (defconst inferior-sml-font-lock-defaults
233    '(inferior-sml-font-lock-keywords nil nil nil nil))    '(inferior-sml-font-lock-keywords nil nil nil nil))
234    
235  ;;; CODE  ;;; CODE
# Line 277  Line 238 
238    '(("\C-c\C-s" . run-sml)    '(("\C-c\C-s" . run-sml)
239      ("\t"       . comint-dynamic-complete))      ("\t"       . comint-dynamic-complete))
240    "Keymap for inferior-sml mode"    "Keymap for inferior-sml mode"
241    :inherit (list sml-bindings comint-mode-map))    :inherit (list sml-bindings comint-mode-map)
242      :group 'sml-proc)
243    
244    
245  ;; buffer-local  ;; buffer-local
# Line 340  Line 302 
302  `sml-prompt-regexp' (default \"^[\\-=] *\")  `sml-prompt-regexp' (default \"^[\\-=] *\")
303      Regexp used to recognise prompts in the inferior ML process.      Regexp used to recognise prompts in the inferior ML process.
304    
 `sml-error-regexp'  
    (default -- complicated)  
     Regexp for matching error messages from the compiler.  
   
 `sml-error-parser' (default 'sml-smlnj-error-parser)  
     This function parses a error messages into a 3, 4 or 5 element list:  
     (file start-line start-col (end-line end-col) err-msg).  
   
305  You can send text to the inferior ML process from other buffers containing  You can send text to the inferior ML process from other buffers containing
306  ML source.  ML source.
307      `switch-to-sml' switches the current buffer to the ML process buffer.      `switch-to-sml' switches the current buffer to the ML process buffer.
# Line 531  Line 485 
485    (interactive)    (interactive)
486    (sml-send-function t))    (sml-send-function t))
487    
   
 ;;; Mouse control and handling dedicated frames for Inferior ML  
   
 ;; simplified from frame.el in Emacs: special-display-popup-frame...  
   
 ;; (defun sml-proc-frame ()  
 ;;   "Returns the current ML process buffer's frame, or creates one first."  
 ;;   (let ((buffer (sml-proc-buffer)))  
 ;;     (window-frame (display-buffer buffer))))  
   
488  ;;; 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
489    
 ;; Only these two functions have to dance around the inane differences  
 ;; between Emacs and XEmacs (fortunately)  
   
 ;; (defun sml-warp-mouse (frame)  
 ;;   "Warp the pointer across the screen to upper right corner of FRAME."  
 ;;   (raise-frame frame)  
 ;;   (cond ((string-match "\\(Lucid\\|XEmacs\\)" emacs-version)  
 ;;          ;; LUCID (19.10) or later... set-m-pos needs a WINDOW  
 ;;          (set-mouse-position (frame-root-window frame) (1- (frame-width)) 0))  
 ;;         (t  
 ;;          ;; GNU, post circa 19.19... set-m-pos needs a FRAME  
 ;;          (set-mouse-position frame (1- (frame-width)) 0)  
 ;;          ;; probably not needed post 19.29  
 ;;          (if (fboundp 'unfocus-frame) (unfocus-frame)))))  
   
490  (defun sml-drag-region (event)  (defun sml-drag-region (event)
491    "Highlight the text the mouse is dragged over, and send it to ML.    "Highlight the text the mouse is dragged over, and send it to ML.
492  This must be bound to a button-down mouse event, currently \\[sml-drag-region].  This must be bound to a button-down mouse event, currently \\[sml-drag-region].
# Line 740  Line 669 
669        (let ((ol sml-error-overlay))        (let ((ol sml-error-overlay))
670          (setq sml-error-overlay (make-overlay 0 0))          (setq sml-error-overlay (make-overlay 0 0))
671          (overlay-put sml-error-overlay 'face (if (symbolp ol) ol 'region))))          (overlay-put sml-error-overlay 'face (if (symbolp ol) ol 'region))))
672      (if undo      (if undo (move-overlay sml-error-overlay 1 1 (current-buffer))
         (move-overlay sml-error-overlay 1 1 (current-buffer))  
673        ;; if active regions, signals mark not active if no region set        ;; if active regions, signals mark not active if no region set
674        (let ((beg (or beg (region-beginning)))        (let ((beg (or beg (region-beginning)))
675              (end (or end (region-end))))              (end (or end (region-end))))
676          (move-overlay sml-error-overlay beg end (current-buffer))))))          (move-overlay sml-error-overlay beg end (current-buffer))))))
677    
 ;; ;;;###autoload  
 ;; (defun sml-next-error (skip)  
 ;;   "Find the next error by parsing the inferior ML buffer.  
 ;; A prefix argument means `sml-skip-errors' (qv) instead.  
   
 ;; Move the error message on the top line of the window\; put the cursor  
 ;; \(point\) at the beginning of the error source.  
   
 ;; If the error message specifies a range, and `sml-error-parser' returns  
 ;; the range, the mark is placed at the end of the range. If the variable  
 ;; `sml-error-overlay' is non-nil, the region will also be highlighted.  
   
 ;; If `sml-error-parser' returns a fifth component this is assumed to be  
 ;; a string to indicate the nature of the error: this will be echoed in  
 ;; the minibuffer.  
   
 ;; Error interaction only works if there is a real file associated with  
 ;; the input -- though of course it also depends on the compiler's error  
 ;; messages \(also see documantation for `sml-error-parser'\).  
   
 ;; However: if the last text sent went via `sml-load-file' (or the temp  
 ;; file mechanism), the next error reported will be relative to the start  
 ;; of the region sent, any error reports in the previous output being  
 ;; forgotten. If the text went directly to the compiler the succeeding  
 ;; error reported will be the next error relative to the location \(in  
 ;; the output\) of the last error. This odd behaviour may have a use...?"  
 ;;   (interactive "P")  
 ;;   (if skip (sml-skip-errors) (sml-do-next-error)))  
   
 ;; (defun sml-do-next-error ()  
 ;;   "The business end of `sml-next-error' (qv)"  
 ;;   (let ((case-fold-search nil)  
 ;;         ;; set this variable iff we called sml-next-error in a SML buffer  
 ;;         (sml-window (if (memq major-mode sml-source-modes) (selected-window)))  
 ;;         (proc-buffer (sml-proc-buffer)))  
 ;;     ;; undo (don't destroy) the previous overlay to be tidy  
 ;;     (sml-error-overlay 'undo 1 1  
 ;;                        (and sml-error-file (get-file-buffer sml-error-file)))  
 ;;     ;; go to interaction buffer but don't raise it's frame  
 ;;     (pop-to-buffer (sml-proc-buffer))  
 ;;     ;; go to the last remembered error, and search for the next one.  
 ;;     (goto-char sml-error-cursor)  
 ;;     (if (not (re-search-forward sml-error-regexp (point-max) t))  
 ;;         ;; no more errors -- move point to the sml prompt at the end  
 ;;         (progn  
 ;;           (goto-char (point-max))  
 ;;           (if sml-window (select-window sml-window)) ;return there, perhaps  
 ;;           (message "No error message(s) found."))  
 ;;       ;; error found: point is at end of last match; set the cursor posn.  
 ;;       (set-marker sml-error-cursor (point))  
 ;;       ;; move the SML window's text up to this line  
 ;;       (set-window-start (get-buffer-window proc-buffer) (match-beginning 0))  
 ;;       (let* ((pos)  
 ;;              (parse (funcall sml-error-parser (match-beginning 0)))  
 ;;              (file (nth 0 parse))  
 ;;              (line0 (nth 1 parse))  
 ;;              (col0 (nth 2 parse))  
 ;;              (line/col1 (nth 3 parse))  
 ;;              (msg (nth 4 parse)))  
 ;;         ;; Give up immediately if the error report is scribble  
 ;;         (if (or (null file) (null line0))  
 ;;             (error "Failed to parse/locate this error properly!"))  
 ;;         ;; decide what to do depending on the file returned  
 ;;         (when (string= file "std_in")  
 ;;        ;; presently a fundamental limitation i'm afraid.  
 ;;        (error "Sorry, can't locate errors on std_in."))  
 ;;      ;; jump to the beginning  
 ;;      (if (string= file (car sml-temp-file))  
 ;;          (let* ((maker (cdr sml-temp-file))  
 ;;                 (buf (marker-buffer marker)))  
 ;;            (display-buffer buf)  
 ;;            (set-buffer buf)  
 ;;            (goto-char marker))  
 ;;        (unless (file-readable-p file) (error "Can't read %s" file))  
 ;;           ;; instead of (find-file-other-window file) to lookup the file  
 ;;           (find-file-other-window file)  
 ;;           ;; no good if the buffer's narrowed, still...  
 ;;           (goto-char (point-min)))  
 ;;      ;; jump to the error  
 ;;      (forward-line (1- line0))  
 ;;      (forward-char (1- col0))  
 ;;      ;; point is at start of error text; seek the end.  
 ;;      (let ((start (point))  
 ;;            (end (and line/col1  
 ;;                      (condition-case nil  
 ;;                          (progn (eval line/col1) (point))  
 ;;                        (error nil)))))  
 ;;        ;; return to start anyway  
 ;;        (goto-char start)  
 ;;        ;; if point went to end, put mark there, and maybe highlight  
 ;;        (if end (progn (push-mark end t)  
 ;;                       (sml-error-overlay nil start end)))  
 ;;        (setq sml-error-file file)   ; remember this for next time  
 ;;        (if msg (message msg))))))) ; echo the error/warning message  
   
 ;; (defun sml-skip-errors ()  
 ;;   "Skip past the rest of the errors."  
 ;;   (interactive)  
 ;;   (if (memq major-mode sml-source-modes) (sml-error-overlay 'undo))  
 ;;   (with-current-buffer (sml-proc-buffer) (sml-update-cursor))  
 ;;   (if (eq major-mode 'sml-inferior-mode) (goto-char (point-max))))  
   
678  ;;; H A C K   A T T A C K !   X E M A C S   /   E M A C S   K E Y S  ;;; H A C K   A T T A C K !   X E M A C S   /   E M A C S   K E Y S
679    
680  (if window-system  (if window-system

Legend:
Removed from v.378  
changed lines
  Added in v.394

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